/ Check-in [008e57dc]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Improved test coverage of tclsqlite.c (CVS 1761)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 008e57dcd5e16886ed732fe1e9797a3c00e8c579
User & Date: drh 2004-06-29 12:39:08
Context
2004-06-29
13:04
Improved test coverage of table.c and printf.c. (CVS 1762) check-in: ba87834d user: drh tags: trunk
12:39
Improved test coverage of tclsqlite.c (CVS 1761) check-in: 008e57dc user: drh tags: trunk
11:26
Add testing for sqlite3_trace() and fix a bug. (CVS 1760) check-in: 7a153910 user: drh tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/tclsqlite.c.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
387
388
389
390
391
392
393
394
395
396
397
398
399
400

401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
...
436
437
438
439
440
441
442

443
444
445
446
447
448
449
...
579
580
581
582
583
584
585

586
587
588
589
590
591
592
...
605
606
607
608
609
610
611



















































612
613
614
615
616
617
618
...
755
756
757
758
759
760
761

762
763
764
765
766
767
768
...
844
845
846
847
848
849
850

















851
852
853
854
855
856
857
...
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
**    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.91 2004/06/29 11:26:59 drh Exp $
*/
#ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */

#include "sqliteInt.h"
#include "tcl.h"
#include <stdlib.h>
#include <string.h>
................................................................................
** subroutine to be invoked.
*/
static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
  SqliteDb *pDb = (SqliteDb*)cd;
  int choice;
  int rc = TCL_OK;
  static const char *DB_strs[] = {
    "authorizer",         "busy",                   "changes",
    "close",              "commit_hook",            "complete",
    "errorcode",          "eval",                   "function",
    "last_insert_rowid",  "onecolumn",
    "progress",           "rekey",                  "timeout",
    "trace",              "collate",                "collation_needed",
    "total_changes",      0                    

  };
  enum DB_enum {
    DB_AUTHORIZER,        DB_BUSY,                   DB_CHANGES,
    DB_CLOSE,             DB_COMMIT_HOOK,            DB_COMPLETE,
    DB_ERRORCODE,         DB_EVAL,                   DB_FUNCTION,
    DB_LAST_INSERT_ROWID, DB_ONECOLUMN,        
    DB_PROGRESS,          DB_REKEY,                  DB_TIMEOUT,
    DB_TRACE,             DB_COLLATE,                DB_COLLATION_NEEDED,
    DB_TOTAL_CHANGES
  };

  if( objc<2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
    return TCL_ERROR;
  }
  if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
................................................................................
  **
  ** If this method is invoked with no arguments, the current authorization
  ** callback string is returned.
  */
  case DB_AUTHORIZER: {
    if( objc>3 ){
      Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");

    }else if( objc==2 ){
      if( pDb->zAuth ){
        Tcl_AppendResult(interp, pDb->zAuth, 0);
      }
    }else{
      char *zAuth;
      int len;
................................................................................
  ** If the callback throws an exception or returns non-zero, then the
  ** transaction is aborted.  If CALLBACK is an empty string, the callback
  ** is disabled.
  */
  case DB_COMMIT_HOOK: {
    if( objc>3 ){
      Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");

    }else if( objc==2 ){
      if( pDb->zCommit ){
        Tcl_AppendResult(interp, pDb->zCommit, 0);
      }
    }else{
      char *zCommit;
      int len;
................................................................................
        sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb);
      }else{
        sqlite3_commit_hook(pDb->db, 0, 0);
      }
    }
    break;
  }




















































  /*    $db complete SQL
  **
  ** Return TRUE if SQL is a complete SQL statement.  Return FALSE if
  ** additional lines of input are needed.  This is similar to the
  ** built-in "info complete" command of Tcl.
  */
................................................................................
    zName = Tcl_GetStringFromObj(objv[2], 0);
    zScript = Tcl_GetStringFromObj(objv[3], &nScript);
    pFunc = (SqlFunc*)Tcl_Alloc( sizeof(*pFunc) + nScript + 1 );
    if( pFunc==0 ) return TCL_ERROR;
    pFunc->interp = interp;
    pFunc->pNext = pDb->pFunc;
    pFunc->zScript = (char*)&pFunc[1];

    strcpy(pFunc->zScript, zScript);
    sqlite3_create_function(pDb->db, zName, -1, SQLITE_UTF8,
        pFunc, tclSqlFunc, 0, 0);
    break;
  }

  /*
................................................................................
      Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
      return TCL_ERROR;
    }
    if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
    sqlite3_busy_timeout(pDb->db, ms);
    break;
  }


















  /*    $db trace ?CALLBACK?
  **
  ** Make arrangements to invoke the CALLBACK routine for each SQL statement
  ** that is executed.  The text of the SQL is appended to CALLBACK before
  ** it is executed.
  */
................................................................................
      }else{
        sqlite3_trace(pDb->db, 0, 0);
      }
    }
    break;
  }

  /*
  **     $db collate NAME SCRIPT
  **
  ** Create a new SQL collation function called NAME.  Whenever
  ** that function is called, invoke SCRIPT to evaluate the function.
  */
  case DB_COLLATE: {
    SqlCollate *pCollate;
    char *zName;
    char *zScript;
    int nScript;
    if( objc!=4 ){
      Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
      return TCL_ERROR;
    }
    zName = Tcl_GetStringFromObj(objv[2], 0);
    zScript = Tcl_GetStringFromObj(objv[3], &nScript);
    pCollate = (SqlCollate*)Tcl_Alloc( sizeof(*pCollate) + nScript + 1 );
    if( pCollate==0 ) return TCL_ERROR;
    pCollate->interp = interp;
    pCollate->pNext = pDb->pCollate;
    pCollate->zScript = (char*)&pCollate[1];
    strcpy(pCollate->zScript, zScript);
    if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8, 
        pCollate, tclSqlCollate) ){
      return TCL_ERROR;
    }
    break;
  }

  /*
  **     $db collate_needed SCRIPT
  **
  ** Create a new SQL collation function called NAME.  Whenever
  ** that function is called, invoke SCRIPT to evaluate the function.
  */
  case DB_COLLATION_NEEDED: {
    if( objc!=3 ){
      Tcl_WrongNumArgs(interp, 2, objv, "SCRIPT");
      return TCL_ERROR;
    }
    if( pDb->pCollateNeeded ){
      Tcl_DecrRefCount(pDb->pCollateNeeded);
    }
    pDb->pCollateNeeded = Tcl_DuplicateObj(objv[2]);
    Tcl_IncrRefCount(pDb->pCollateNeeded);
    sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded);
    break;
  }

  /*
  **     $db total_changes
  **
  ** Return the number of rows that were modified, inserted, or deleted 
  ** since the database handle was created.
  */
  case DB_TOTAL_CHANGES: {
    Tcl_Obj *pResult;
    if( objc!=2 ){
      Tcl_WrongNumArgs(interp, 2, objv, "");
      return TCL_ERROR;
    }
    pResult = Tcl_GetObjResult(interp);
    Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db));
    break;
  }

  } /* End of the SWITCH statement */
  return rc;
}

/*
**   sqlite DBNAME FILENAME ?MODE? ?-key KEY?
**







|







 







|
|
|
|
|
<
|
>


|
|
|
|
|
<
|







 







>







 







>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
387
388
389
390
391
392
393
394
395
396
397
398

399
400
401
402
403
404
405
406
407

408
409
410
411
412
413
414
415
...
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
...
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
...
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
...
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
...
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
...
952
953
954
955
956
957
958



































































959
960
961
962
963
964
965
**    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.92 2004/06/29 12:39:08 drh Exp $
*/
#ifndef NO_TCL     /* Omit this whole file if TCL is unavailable */

#include "sqliteInt.h"
#include "tcl.h"
#include <stdlib.h>
#include <string.h>
................................................................................
** subroutine to be invoked.
*/
static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
  SqliteDb *pDb = (SqliteDb*)cd;
  int choice;
  int rc = TCL_OK;
  static const char *DB_strs[] = {
    "authorizer",         "busy",              "changes",
    "close",              "collate",           "collation_needed",
    "commit_hook",        "complete",          "errorcode",
    "eval",               "function",          "last_insert_rowid",
    "onecolumn",          "progress",          "rekey",

    "timeout",            "total_changes",     "trace",
    0                    
  };
  enum DB_enum {
    DB_AUTHORIZER,        DB_BUSY,             DB_CHANGES,
    DB_CLOSE,             DB_COLLATE,          DB_COLLATION_NEEDED,
    DB_COMMIT_HOOK,       DB_COMPLETE,         DB_ERRORCODE,
    DB_EVAL,              DB_FUNCTION,         DB_LAST_INSERT_ROWID,
    DB_ONECOLUMN,         DB_PROGRESS,         DB_REKEY,

    DB_TIMEOUT,           DB_TOTAL_CHANGES,    DB_TRACE,
  };

  if( objc<2 ){
    Tcl_WrongNumArgs(interp, 1, objv, "SUBCOMMAND ...");
    return TCL_ERROR;
  }
  if( Tcl_GetIndexFromObj(interp, objv[1], DB_strs, "option", 0, &choice) ){
................................................................................
  **
  ** If this method is invoked with no arguments, the current authorization
  ** callback string is returned.
  */
  case DB_AUTHORIZER: {
    if( objc>3 ){
      Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
      return TCL_ERROR;
    }else if( objc==2 ){
      if( pDb->zAuth ){
        Tcl_AppendResult(interp, pDb->zAuth, 0);
      }
    }else{
      char *zAuth;
      int len;
................................................................................
  ** If the callback throws an exception or returns non-zero, then the
  ** transaction is aborted.  If CALLBACK is an empty string, the callback
  ** is disabled.
  */
  case DB_COMMIT_HOOK: {
    if( objc>3 ){
      Tcl_WrongNumArgs(interp, 2, objv, "?CALLBACK?");
      return TCL_ERROR;
    }else if( objc==2 ){
      if( pDb->zCommit ){
        Tcl_AppendResult(interp, pDb->zCommit, 0);
      }
    }else{
      char *zCommit;
      int len;
................................................................................
        sqlite3_commit_hook(pDb->db, DbCommitHandler, pDb);
      }else{
        sqlite3_commit_hook(pDb->db, 0, 0);
      }
    }
    break;
  }

  /*
  **     $db collate NAME SCRIPT
  **
  ** Create a new SQL collation function called NAME.  Whenever
  ** that function is called, invoke SCRIPT to evaluate the function.
  */
  case DB_COLLATE: {
    SqlCollate *pCollate;
    char *zName;
    char *zScript;
    int nScript;
    if( objc!=4 ){
      Tcl_WrongNumArgs(interp, 2, objv, "NAME SCRIPT");
      return TCL_ERROR;
    }
    zName = Tcl_GetStringFromObj(objv[2], 0);
    zScript = Tcl_GetStringFromObj(objv[3], &nScript);
    pCollate = (SqlCollate*)Tcl_Alloc( sizeof(*pCollate) + nScript + 1 );
    if( pCollate==0 ) return TCL_ERROR;
    pCollate->interp = interp;
    pCollate->pNext = pDb->pCollate;
    pCollate->zScript = (char*)&pCollate[1];
    pDb->pCollate = pCollate;
    strcpy(pCollate->zScript, zScript);
    if( sqlite3_create_collation(pDb->db, zName, SQLITE_UTF8, 
        pCollate, tclSqlCollate) ){
      return TCL_ERROR;
    }
    break;
  }

  /*
  **     $db collation_needed SCRIPT
  **
  ** Create a new SQL collation function called NAME.  Whenever
  ** that function is called, invoke SCRIPT to evaluate the function.
  */
  case DB_COLLATION_NEEDED: {
    if( objc!=3 ){
      Tcl_WrongNumArgs(interp, 2, objv, "SCRIPT");
      return TCL_ERROR;
    }
    if( pDb->pCollateNeeded ){
      Tcl_DecrRefCount(pDb->pCollateNeeded);
    }
    pDb->pCollateNeeded = Tcl_DuplicateObj(objv[2]);
    Tcl_IncrRefCount(pDb->pCollateNeeded);
    sqlite3_collation_needed(pDb->db, pDb, tclCollateNeeded);
    break;
  }

  /*    $db complete SQL
  **
  ** Return TRUE if SQL is a complete SQL statement.  Return FALSE if
  ** additional lines of input are needed.  This is similar to the
  ** built-in "info complete" command of Tcl.
  */
................................................................................
    zName = Tcl_GetStringFromObj(objv[2], 0);
    zScript = Tcl_GetStringFromObj(objv[3], &nScript);
    pFunc = (SqlFunc*)Tcl_Alloc( sizeof(*pFunc) + nScript + 1 );
    if( pFunc==0 ) return TCL_ERROR;
    pFunc->interp = interp;
    pFunc->pNext = pDb->pFunc;
    pFunc->zScript = (char*)&pFunc[1];
    pDb->pFunc = pFunc;
    strcpy(pFunc->zScript, zScript);
    sqlite3_create_function(pDb->db, zName, -1, SQLITE_UTF8,
        pFunc, tclSqlFunc, 0, 0);
    break;
  }

  /*
................................................................................
      Tcl_WrongNumArgs(interp, 2, objv, "MILLISECONDS");
      return TCL_ERROR;
    }
    if( Tcl_GetIntFromObj(interp, objv[2], &ms) ) return TCL_ERROR;
    sqlite3_busy_timeout(pDb->db, ms);
    break;
  }

  /*
  **     $db total_changes
  **
  ** Return the number of rows that were modified, inserted, or deleted 
  ** since the database handle was created.
  */
  case DB_TOTAL_CHANGES: {
    Tcl_Obj *pResult;
    if( objc!=2 ){
      Tcl_WrongNumArgs(interp, 2, objv, "");
      return TCL_ERROR;
    }
    pResult = Tcl_GetObjResult(interp);
    Tcl_SetIntObj(pResult, sqlite3_total_changes(pDb->db));
    break;
  }

  /*    $db trace ?CALLBACK?
  **
  ** Make arrangements to invoke the CALLBACK routine for each SQL statement
  ** that is executed.  The text of the SQL is appended to CALLBACK before
  ** it is executed.
  */
................................................................................
      }else{
        sqlite3_trace(pDb->db, 0, 0);
      }
    }
    break;
  }




































































  } /* End of the SWITCH statement */
  return rc;
}

/*
**   sqlite DBNAME FILENAME ?MODE? ?-key KEY?
**

Changes to test/auth.test.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
..
32
33
34
35
36
37
38



39
40
41
42
43
44
45
#    May you share freely, never taking more than you give.
#
#***********************************************************************
# This file implements regression tests for SQLite library.  The
# focus of this script is testing the ATTACH and DETACH commands
# and related functionality.
#
# $Id: auth.test,v 1.15 2004/06/19 00:16:31 drh Exp $
#

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

# disable this test if the SQLITE_OMIT_AUTHORIZATION macro is
# defined during compilation.
................................................................................
  }
  db authorizer ::auth
  catchsql {CREATE TABLE t1(a,b,c)}
} {1 {not authorized}}
do_test auth-1.1.2 {
  db errorcode
} {23}



do_test auth-1.2 {
  execsql {SELECT name FROM sqlite_master}
} {}
do_test auth-1.3.1 {
  proc auth {code arg1 arg2 arg3 arg4} {
    if {$code=="SQLITE_CREATE_TABLE"} {
      set ::authargs [list $arg1 $arg2 $arg3 $arg4]







|







 







>
>
>







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
..
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
#    May you share freely, never taking more than you give.
#
#***********************************************************************
# This file implements regression tests for SQLite library.  The
# focus of this script is testing the ATTACH and DETACH commands
# and related functionality.
#
# $Id: auth.test,v 1.16 2004/06/29 12:39:08 drh Exp $
#

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

# disable this test if the SQLITE_OMIT_AUTHORIZATION macro is
# defined during compilation.
................................................................................
  }
  db authorizer ::auth
  catchsql {CREATE TABLE t1(a,b,c)}
} {1 {not authorized}}
do_test auth-1.1.2 {
  db errorcode
} {23}
do_test auth-1.1.3 {
  db authorizer
} {::auth}
do_test auth-1.2 {
  execsql {SELECT name FROM sqlite_master}
} {}
do_test auth-1.3.1 {
  proc auth {code arg1 arg2 arg3 arg4} {
    if {$code=="SQLITE_CREATE_TABLE"} {
      set ::authargs [list $arg1 $arg2 $arg3 $arg4]

Changes to test/hook.test.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
..
75
76
77
78
79
80
81

82









83
# This file implements regression tests for TCL interface to the
# SQLite library. 
#
# The focus of the tests in this file is the  following interface:
#
#      sqlite_commit_hook
#
# $Id: hook.test,v 1.4 2004/05/31 08:26:49 danielk1977 Exp $

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

do_test hook-1.2 {
  db commit_hook
} {}
................................................................................
do_test hook-3.7 {
  set ::commit_cnt
} {1 2 2 3 3 4 4 5 5 6 6 7}
do_test hook-3.8 {
  execsql {SELECT * FROM t2}
} {1 2 2 3 3 4 4 5 5 6}












finish_test







|







 







>
|
>
>
>
>
>
>
>
>
>

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
..
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
# This file implements regression tests for TCL interface to the
# SQLite library. 
#
# The focus of the tests in this file is the  following interface:
#
#      sqlite_commit_hook
#
# $Id: hook.test,v 1.5 2004/06/29 12:39:08 drh Exp $

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

do_test hook-1.2 {
  db commit_hook
} {}
................................................................................
do_test hook-3.7 {
  set ::commit_cnt
} {1 2 2 3 3 4 4 5 5 6 6 7}
do_test hook-3.8 {
  execsql {SELECT * FROM t2}
} {1 2 2 3 3 4 4 5 5 6}

# Test turnning off the commit hook
#
do_test hook-3.9 {
  db commit_hook {}
  set ::commit_cnt {}
  execsql {
    INSERT INTO t2 VALUES(7,8);
  }
  set ::commit_cnt
} {}

finish_test

Changes to test/progress.test.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
..
40
41
42
43
44
45
46







47
48
49
50
51
52
53
#    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 file is testing the 'progress callback'.
#
# $Id: progress.test,v 1.2 2004/05/31 08:26:50 danielk1977 Exp $

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

# Build some test data
#
execsql {
................................................................................
  set counter 0
  db progress 1 "[namespace code {incr counter}] ; expr 0"
  execsql {
    SELECT * FROM t1
  }
  expr $counter > 1
} 1








# Test that the query is abandoned when the progress callback returns non-zero
do_test progress1.1 {
  set counter 0
  db progress 1 "[namespace code {incr counter}] ; expr 1"
  set rc [catch {execsql {
    SELECT * FROM t1







|







 







>
>
>
>
>
>
>







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
..
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
#    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 file is testing the 'progress callback'.
#
# $Id: progress.test,v 1.3 2004/06/29 12:39:08 drh Exp $

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

# Build some test data
#
execsql {
................................................................................
  set counter 0
  db progress 1 "[namespace code {incr counter}] ; expr 0"
  execsql {
    SELECT * FROM t1
  }
  expr $counter > 1
} 1
do_test progress-1.0.1 {
  db progress
} {::namespace inscope :: {incr counter} ; expr 0}
do_test progress-1.0.2 {
  set v [catch {db progress xyz bogus} msg]
  lappend v $msg
} {1 {expected integer but got "xyz"}}

# Test that the query is abandoned when the progress callback returns non-zero
do_test progress1.1 {
  set counter 0
  db progress 1 "[namespace code {incr counter}] ; expr 1"
  set rc [catch {execsql {
    SELECT * FROM t1

Changes to test/tclsqlite.test.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
..
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
..
66
67
68
69
70
71
72





























































73
74
75
76
77
78
79
..
98
99
100
101
102
103
104




105

106












107
# 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.25 2004/06/21 06:50:29 danielk1977 Exp $

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

# Check the error messages generated by tclsqlite
#
if {[sqlite3 -has-codec]} {
................................................................................
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, changes, close, commit_hook, complete, errorcode, eval, function, last_insert_rowid, onecolumn, progress, rekey, timeout, trace, collate, collation_needed, or total_changes}}
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"
    }
................................................................................
    db eval {SELECT * FROM t1} data {
      expr x*
    }
  } msg]
  regsub {:.*$} $msg {} msg
  lappend v $msg
} {1 {syntax error in expression "x*"}}






























































if {[sqlite3 -tcl-uses-utf]} {
  do_test tcl-2.1 {
    execsql "CREATE TABLE t\u0123x(a int, b\u1235 float)"
    execsql "PRAGMA table_info(t\u0123x)"
  } "0 a int 0 {} 0 1 b\u1235 float 0 {} 0"
  do_test tcl-2.2 {
................................................................................
do_test tcl-3.2 {
  db onecolumn {SELECT * FROM t1 WHERE a<0}
} {}
do_test tcl-3.3 {
  set rc [catch {db onecolumn} errmsg]
  lappend rc $errmsg
} {1 {wrong # args: should be "db onecolumn SQL"}}



















finish_test







|







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>

>
|
>
>
>
>
>
>
>
>
>
>
>
>

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
..
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
..
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
...
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
# 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.26 2004/06/29 12:39:08 drh Exp $

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

# Check the error messages generated by tclsqlite
#
if {[sqlite3 -has-codec]} {
................................................................................
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, changes, close, collate, collation_needed, commit_hook, complete, errorcode, eval, function, last_insert_rowid, onecolumn, progress, rekey, timeout, total_changes, or trace}}
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"
    }
................................................................................
    db eval {SELECT * FROM t1} data {
      expr x*
    }
  } msg]
  regsub {:.*$} $msg {} msg
  lappend v $msg
} {1 {syntax error in expression "x*"}}
do_test tcl-1.7 {
  set v [catch {db} msg]
  lappend v $msg
} {1 {wrong # args: should be "db SUBCOMMAND ..."}}
do_test tcl-1.8 {
  set v [catch {db authorizer 1 2 3} msg]
  lappend v $msg
} {1 {wrong # args: should be "db authorizer ?CALLBACK?"}}
do_test tcl-1.9 {
  set v [catch {db busy 1 2 3} msg]
  lappend v $msg
} {1 {wrong # args: should be "db busy CALLBACK"}}
do_test tcl-1.10 {
  set v [catch {db progress 1} msg]
  lappend v $msg
} {1 {wrong # args: should be "db progress N CALLBACK"}}
do_test tcl-1.11 {
  set v [catch {db changes xyz} msg]
  lappend v $msg
} {1 {wrong # args: should be "db changes "}}
do_test tcl-1.12 {
  set v [catch {db commit_hook a b c} msg]
  lappend v $msg
} {1 {wrong # args: should be "db commit_hook ?CALLBACK?"}}
do_test tcl-1.13 {
  set v [catch {db complete} msg]
  lappend v $msg
} {1 {wrong # args: should be "db complete SQL"}}
do_test tcl-1.14 {
  set v [catch {db eval} msg]
  lappend v $msg
} {1 {wrong # args: should be "db eval SQL ?ARRAY-NAME CODE?"}}
do_test tcl-1.15 {
  set v [catch {db function} msg]
  lappend v $msg
} {1 {wrong # args: should be "db function NAME SCRIPT"}}
do_test tcl-1.14 {
  set v [catch {db last_insert_rowid xyz} msg]
  lappend v $msg
} {1 {wrong # args: should be "db last_insert_rowid "}}
do_test tcl-1.15 {
  set v [catch {db rekey} msg]
  lappend v $msg
} {1 {wrong # args: should be "db rekey KEY"}}
do_test tcl-1.16 {
  set v [catch {db timeout} msg]
  lappend v $msg
} {1 {wrong # args: should be "db timeout MILLISECONDS"}}
do_test tcl-1.17 {
  set v [catch {db collate} msg]
  lappend v $msg
} {1 {wrong # args: should be "db collate NAME SCRIPT"}}
do_test tcl-1.18 {
  set v [catch {db collation_needed} msg]
  lappend v $msg
} {1 {wrong # args: should be "db collation_needed SCRIPT"}}
do_test tcl-1.19 {
  set v [catch {db total_changes xyz} msg]
  lappend v $msg
} {1 {wrong # args: should be "db total_changes "}}


if {[sqlite3 -tcl-uses-utf]} {
  do_test tcl-2.1 {
    execsql "CREATE TABLE t\u0123x(a int, b\u1235 float)"
    execsql "PRAGMA table_info(t\u0123x)"
  } "0 a int 0 {} 0 1 b\u1235 float 0 {} 0"
  do_test tcl-2.2 {
................................................................................
do_test tcl-3.2 {
  db onecolumn {SELECT * FROM t1 WHERE a<0}
} {}
do_test tcl-3.3 {
  set rc [catch {db onecolumn} errmsg]
  lappend rc $errmsg
} {1 {wrong # args: should be "db onecolumn SQL"}}
do_test tcl-3.4 {
  set rc [catch {db onecolumn {SELECT bogus}} errmsg]
  lappend rc $errmsg
} {1 {no such column: bogus}}

# Turn the busy handler on and off
#
do_test tcl-4.1 {
  proc busy_callback {cnt} {
    break
  }
  db busy busy_callback
  db busy
} {busy_callback}
do_test tcl-4.2 {
  db busy {}
  db busy
} {}

finish_test