Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Add the "exists" method to the TCL interface. (CVS 2813) |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
8a355d7aade5c7a95ab08aeedf1ee185 |
User & Date: | drh 2005-12-10 21:19:05.000 |
Context
2005-12-12
| ||
06:53 | Fix minor malloc() related problems and add sqlite3_soft_heap_limit() stubs. (CVS 2814) (check-in: 1637f37960 user: danielk1977 tags: trunk) | |
2005-12-10
| ||
21:19 | Add the "exists" method to the TCL interface. (CVS 2813) (check-in: 8a355d7aad user: drh tags: trunk) | |
2005-12-09
| ||
20:54 | New bind tests (check-ins (2797) and (2798)) only work right on a UTF8 database. So make sure they are only run when the database is UTF8. (CVS 2812) (check-in: 3980379069 user: drh tags: trunk) | |
Changes
Changes to src/tclsqlite.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 | /* ** 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 ** | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | /* ** 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.136 2005/12/10 21:19:05 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> |
︙ | ︙ | |||
617 618 619 620 621 622 623 | int choice; int rc = TCL_OK; static const char *DB_strs[] = { "authorizer", "busy", "cache", "changes", "close", "collate", "collation_needed", "commit_hook", "complete", "copy", "errorcode", "eval", | | | | > | < | | | | > | 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 | int choice; int rc = TCL_OK; static const char *DB_strs[] = { "authorizer", "busy", "cache", "changes", "close", "collate", "collation_needed", "commit_hook", "complete", "copy", "errorcode", "eval", "exists", "function", "last_insert_rowid", "nullvalue", "onecolumn", "profile", "progress", "rekey", "timeout", "total_changes", "trace", "transaction", "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_ERRORCODE, DB_EVAL, DB_EXISTS, DB_FUNCTION, DB_LAST_INSERT_ROWID, DB_NULLVALUE, DB_ONECOLUMN, DB_PROFILE, DB_PROGRESS, DB_REKEY, DB_TIMEOUT, DB_TOTAL_CHANGES, DB_TRACE, DB_TRANSACTION, 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; } |
︙ | ︙ | |||
1132 1133 1134 1135 1136 1137 1138 | ** If "array" is an empty string, then the values are placed in variables ** that have the same name as the fields extracted by the query. ** ** The onecolumn method is the equivalent of: ** lindex [$db eval $sql] 0 */ case DB_ONECOLUMN: | | > | < < < < < < > > > > > > > > > | 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 | ** If "array" is an empty string, then the values are placed in variables ** that have the same name as the fields extracted by the query. ** ** The onecolumn method is the equivalent of: ** lindex [$db eval $sql] 0 */ case DB_ONECOLUMN: case DB_EVAL: case DB_EXISTS: { char const *zSql; /* Next SQL statement to execute */ char const *zLeft; /* What is left after first stmt in zSql */ sqlite3_stmt *pStmt; /* Compiled SQL statment */ Tcl_Obj *pArray; /* Name of array into which results are written */ Tcl_Obj *pScript; /* Script to run for each result set */ Tcl_Obj **apParm; /* Parameters that need a Tcl_DecrRefCount() */ int nParm; /* Number of entries used in apParm[] */ Tcl_Obj *aParm[10]; /* Static space for apParm[] in the common case */ Tcl_Obj *pRet; /* Value to be returned */ SqlPreparedStmt *pPreStmt; /* Pointer to a prepared statement */ int rc2; if( choice==DB_EVAL ){ if( objc<3 || objc>5 ){ Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?"); return TCL_ERROR; } pRet = Tcl_NewObj(); Tcl_IncrRefCount(pRet); }else{ if( objc!=3 ){ Tcl_WrongNumArgs(interp, 2, objv, "SQL"); return TCL_ERROR; } pRet = 0; if( choice==DB_EXISTS ){ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); } } if( objc==3 ){ pArray = pScript = 0; }else if( objc==4 ){ pArray = 0; pScript = objv[3]; }else{ |
︙ | ︙ | |||
1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 | if( pScript ){ if( pArray==0 ){ Tcl_ObjSetVar2(interp, apColName[i], 0, pVal, 0); }else{ Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0); } }else if( choice==DB_ONECOLUMN ){ if( pRet==0 ){ pRet = pVal; Tcl_IncrRefCount(pRet); } rc = TCL_BREAK; }else{ Tcl_ListObjAppendElement(interp, pRet, pVal); } } if( pScript ){ rc = Tcl_EvalObjEx(interp, pScript, 0); | > > > > > > > | 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 | if( pScript ){ if( pArray==0 ){ Tcl_ObjSetVar2(interp, apColName[i], 0, pVal, 0); }else{ Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0); } }else if( choice==DB_ONECOLUMN ){ assert( pRet==0 ); if( pRet==0 ){ pRet = pVal; Tcl_IncrRefCount(pRet); } rc = TCL_BREAK; i = nCol; }else if( choice==DB_EXISTS ){ assert( pRet==0 ); Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); rc = TCL_BREAK; i = nCol; }else{ Tcl_ListObjAppendElement(interp, pRet, pVal); } } if( pScript ){ rc = Tcl_EvalObjEx(interp, pScript, 0); |
︙ | ︙ |
Changes to test/tclsqlite.test.
︙ | ︙ | |||
11 12 13 14 15 16 17 | # 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. # | | | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 | # 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.45 2005/12/10 21:19:06 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, errorcode, eval, exists, function, last_insert_rowid, nullvalue, onecolumn, profile, progress, rekey, timeout, total_changes, trace, transaction, 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" } |
︙ | ︙ | |||
430 431 432 433 434 435 436 437 438 | } } }] } {2} do_test tcl-10.13 { db eval {SELECT * FROM t4} } {1 2 3 4 5 6 7} finish_test | > > > > > > > > > > | 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 | } } }] } {2} do_test tcl-10.13 { db eval {SELECT * FROM t4} } {1 2 3 4 5 6 7} do_test tcl-11.1 { db exists {SELECT x,x*2,x+x FROM t4 WHERE x==4} } {1} do_test tcl-11.2 { db exists {SELECT 0 FROM t4 WHERE x==4} } {1} do_test tcl-11.3 { db exists {SELECT 1 FROM t4 WHERE x==8} } {0} finish_test |