SQLite

/*
** 2001 September 15
**
** The author disclaims copyright to this source code.  In place of
** a legal notice, here is a blessing:
**
**    May you do good and not evil.
**    May you find forgiveness for yourself and forgive others.
**    May you share freely, never taking more than you give.
**
*************************************************************************
** A TCL Interface to SQLite
**
** $Id: tclsqlite.c,v 1.165 2006/07/17 00:02:45 drh Exp $
*/
#ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */

#include "sqliteInt.h"
#include "hash.h"
#include "tcl.h"
#include <stdlib.h>

  int rc = TCL_OK;
  static const char *DB_strs[] = {
    "authorizer",         "busy",              "cache",
    "changes",            "close",             "collate",
    "collation_needed",   "commit_hook",       "complete",
    "copy",               "enable_load_extension","errorcode",
    "eval",               "exists",            "function",
    "interrupt",          "last_insert_rowid", "nullvalue",
    "onecolumn",          "profile",           "progress",
    "rekey",              "rollback_hook",     "timeout",
    "total_changes",      "trace",             "transaction",
    "update_hook",        "version",           0
  };
  enum DB_enum {
    DB_AUTHORIZER,        DB_BUSY,             DB_CACHE,
    DB_CHANGES,           DB_CLOSE,            DB_COLLATE,
    DB_COLLATION_NEEDED,  DB_COMMIT_HOOK,      DB_COMPLETE,
    DB_COPY,              DB_ENABLE_LOAD_EXTENSION,DB_ERRORCODE,
    DB_EVAL,              DB_EXISTS,           DB_FUNCTION,
    DB_INTERRUPT,         DB_LAST_INSERT_ROWID,DB_NULLVALUE,
    DB_ONECOLUMN,         DB_PROFILE,          DB_PROGRESS,
    DB_REKEY,             DB_ROLLBACK_HOOK,    DB_TIMEOUT,
    DB_TOTAL_CHANGES,     DB_TRACE,            DB_TRANSACTION,
    DB_UPDATE_HOOK,       DB_VERSION,          
  };
  /* don't leave trailing commas on DB_enum, it confuses the AIX xlc compiler */

  if( objc<2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
    return TCL_ERROR;
  }

      Tcl_SetResult(interp, (char *)sqlite3_errmsg(pDb->db), TCL_VOLATILE);
    }else{
      /* Must flush any cached statements */
      flushStmtCache( pDb );
    }
    break;
  }

  /*
  **     $db interrupt
  **
  ** Interrupt the execution of the inner-most SQL interpreter.  This
  ** causes the SQL statement to return an error of SQLITE_INTERRUPT.
  */
  case DB_INTERRUPT: {
    sqlite3_interrupt(pDb->db);
    break;
  }

  /*
  **     $db nullvalue ?STRING?
  **
  ** Change text used when a NULL comes back from the database. If ?STRING?
  ** is not present, then the current string used for NULL is returned.
  ** If STRING is present, then STRING is returned.

# 2004 Feb 8
#
# The author disclaims copyright to this source code.  In place of
# a legal notice, here is a blessing:
#
#    May you do good and not evil.
#    May you find forgiveness for yourself and forgive others.
#    May you share freely, never taking more than you give.
#
#***********************************************************************
# This file implements regression tests for SQLite library.  The
# focus of this script is the sqlite_interrupt() API.
#
# $Id: interrupt.test,v 1.13 2006/07/17 00:02:46 drh Exp $


set testdir [file dirname $argv0]
source $testdir/tester.tcl
set DB [sqlite3_connection_pointer db]

# Compute a checksum on the entire database.

  }
  set cksum [string length $txt]-[md5 $txt]
  # puts $cksum-[file size test.db]
  return $cksum
}

# This routine attempts to execute the sql in $sql.  It triggers an
# interrupt at progressively later and later points during the processing
# and checks to make sure SQLITE_INTERRUPT is returned.  Eventually,
# the routine completes successfully.
#
proc interrupt_test {testid sql result {initcnt 0}} {
  set orig_sum [cksum]
  set i $initcnt
  while 1 {

}

# Interrupt during parsing
#
do_test interrupt-5.1 {
  proc fake_interrupt {args} {sqlite3_interrupt $::DB; return SQLITE_OK}
  db collation_needed fake_interrupt
  catchsql {
    CREATE INDEX fake ON fake1(a COLLATE fake_collation, b, c DESC);
  }
} {1 interrupt}
do_test interrupt-5.2 {
  proc fake_interrupt {args} {db interrupt; return SQLITE_OK}
  db collation_needed fake_interrupt
  catchsql {
    CREATE INDEX fake ON fake1(a COLLATE fake_collation, b, c DESC);
  }
} {1 interrupt}

finish_test

# This file implements regression tests for TCL interface to the
# SQLite library. 
#
# Actually, all tests are based on the TCL interface, so the main
# interface is pretty well tested.  This file contains some addition
# tests for fringe issues that the main test suite does not cover.
#
# $Id: tclsqlite.test,v 1.55 2006/07/17 00:02:46 drh Exp $

set testdir [file dirname $argv0]
source $testdir/tester.tcl

# Check the error messages generated by tclsqlite
#
if {[sqlite3 -has-codec]} {
  set r "sqlite_orig HANDLE FILENAME ?-key CODEC-KEY?"
} else {
  set r "sqlite3 HANDLE FILENAME ?MODE?"
}
do_test tcl-1.1 {
  set v [catch {sqlite3 bogus} msg]
  lappend v $msg
} [list 1 "wrong # args: should be \"$r\""]
do_test tcl-1.2 {
  set v [catch {db bogus} msg]
  lappend v $msg
} {1 {bad option "bogus": must be authorizer, busy, cache, changes, close, collate, collation_needed, commit_hook, complete, copy, enable_load_extension, errorcode, eval, exists, function, interrupt, last_insert_rowid, nullvalue, onecolumn, profile, progress, rekey, rollback_hook, timeout, total_changes, trace, transaction, update_hook, or version}}
do_test tcl-1.3 {
  execsql {CREATE TABLE t1(a int, b int)}
  execsql {INSERT INTO t1 VALUES(10,20)}
  set v [catch {
    db eval {SELECT * FROM t1} data {
      error "The error message"
    }