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.130 2005/08/02 17:15:15 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>

      static const char *TTYPE_strs[] = {
        "deferred",   "exclusive",  "immediate"
      };
      enum TTYPE_enum {
        TTYPE_DEFERRED, TTYPE_EXCLUSIVE, TTYPE_IMMEDIATE
      };
      int ttype;
      if( Tcl_GetIndexFromObj(interp, objv[2], TTYPE_strs, "transaction type",
                              0, &ttype) ){
        return TCL_ERROR;
      }
      switch( (enum TTYPE_enum)ttype ){
        case TTYPE_DEFERRED:    /* no-op */;                 break;
        case TTYPE_EXCLUSIVE:   zBegin = "BEGIN EXCLUSIVE";  break;
        case TTYPE_IMMEDIATE:   zBegin = "BEGIN IMMEDIATE";  break;

# 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.43 2005/08/02 17:15:16 drh Exp $

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

# Check the error messages generated by tclsqlite
#
if {[sqlite3 -has-codec]} {

  db function r1 userfunc_r1
  execsql {SELECT r1(10)}
} {55}
do_test tcl-9.11 {
  execsql {SELECT r1(100)}
} {5050}

# Tests for the new transaction method
#
do_test tcl-10.1 {
  db transaction {}
} {}
do_test tcl-10.2 {
  db transaction deferred {}
} {}
do_test tcl-10.3 {
  db transaction immediate {}
} {}
do_test tcl-10.4 {
  db transaction exclusive {}
} {}
do_test tcl-10.5 {
  set rc [catch {db transaction xyzzy {}} msg]
  lappend rc $msg
} {1 {bad transaction type "xyzzy": must be deferred, exclusive, or immediate}}
do_test tcl-10.6 {
  set rc [catch {db transaction {error test-error}} msg]
  lappend rc $msg
} {1 test-error}
do_test tcl-10.7 {
  db transaction {
    db eval {CREATE TABLE t4(x)}
    db transaction {
      db eval {INSERT INTO t4 VALUES(1)}
    }
  }
  db eval {SELECT * FROM t4}
} 1
do_test tcl-10.8 {
  catch {
    db transaction {
      db eval {INSERT INTO t4 VALUES(2)}
      db eval {INSERT INTO t4 VALUES(3)}
      db eval {INSERT INTO t4 VALUES(4)}
      error test-error
    }
  }
  db eval {SELECT * FROM t4}
} 1
do_test tcl-10.9 {
  db transaction {
    db eval {INSERT INTO t4 VALUES(2)}
    catch {
      db transaction {
        db eval {INSERT INTO t4 VALUES(3)}
        db eval {INSERT INTO t4 VALUES(4)}
        error test-error
      }
    }
  }
  db eval {SELECT * FROM t4}
} {1 2 3 4}
do_test tcl-10.10 {
  for {set i 0} {$i<1} {incr i} {
    db transaction {
      db eval {INSERT INTO t4 VALUES(5)}
      continue
    }
  }
  db eval {SELECT * FROM t4}
} {1 2 3 4 5}
do_test tcl-10.11 {
  for {set i 0} {$i<10} {incr i} {
    db transaction {
      db eval {INSERT INTO t4 VALUES(6)}
      break
    }
  }
  db eval {SELECT * FROM t4}
} {1 2 3 4 5 6}
do_test tcl-10.12 {
  set rc [catch {
    for {set i 0} {$i<10} {incr i} {
      db transaction {
        db eval {INSERT INTO t4 VALUES(7)}
        return
      }
    }
  }]
} {2}
do_test tcl-10.13 {
  db eval {SELECT * FROM t4}
} {1 2 3 4 5 6 7}

finish_test