Fix the onecolumn method in the TCL interface so that it works the same

as the eval method in all ways except for returning just the first value
in the result set. (CVS 1944)

FossilOrigin-Name: f323e4f86a08fe6448cbd4ff7cab459e8039d9f1
This commit is contained in:
drh 2004-09-07 13:20:35 +00:00
parent af805ca035
commit 1807ce37b8
4 changed files with 98 additions and 111 deletions

View File

@ -1,5 +1,5 @@
C Lemon\sescapes\sbackslashes\sin\sfilenames\sin\s#line\sdirectives\sit\sgenerates.\nTicket\s#892.\s(CVS\s1943)
D 2004-09-07T11:28:25
C Fix\sthe\sonecolumn\smethod\sin\sthe\sTCL\sinterface\sso\sthat\sit\sworks\sthe\ssame\nas\sthe\seval\smethod\sin\sall\sways\sexcept\sfor\sreturning\sjust\sthe\sfirst\svalue\nin\sthe\sresult\sset.\s(CVS\s1944)
D 2004-09-07T13:20:35
F Makefile.in 65a7c43fcaf9a710d62f120b11b6e435eeb4a450
F Makefile.linux-gcc a9e5a0d309fa7c38e7c14d3ecf7690879d3a5457
F README f1de682fbbd94899d50aca13d387d1b3fd3be2dd
@ -63,7 +63,7 @@ F src/shell.c 4f1a2760ced81c829defb47b0a3b61ffec61b604
F src/sqlite.h.in 8bdf3fc4c76040f939cb1831eb97babf6a2fa858
F src/sqliteInt.h 0840e651db8e16f88f2b8a2393ac98dfdbf01df0
F src/table.c 8168c6e824009f8485bff79fc60ea8fea6829b10
F src/tclsqlite.c ad6460a22cee18f292614a083cd15db670298213
F src/tclsqlite.c 9225350a3144b3c0dd07a3cc88d2c219d57e2f0d
F src/test1.c 0a7ae23d822177ecf3e8b577d026f0c8a39fe5c3
F src/test2.c f4c2f3928f1998fd8cb75a81e33a60e025ea85d4
F src/test3.c 94d0a2a90bccd85802488cb42c69ec8afd2e4646
@ -170,7 +170,7 @@ F test/sort.test 35e9d6bd6930969050606c8feb9c6745469720e3
F test/subselect.test 50f98723f00e97b1839d36410ee63597ca82d775
F test/table.test fd9a0f4992230e4ca89cd37ae3191a12750df1d0
F test/tableapi.test b21ab097e87a5484bb61029e69e1a4e5c5e65ede
F test/tclsqlite.test d84b91f5e8219bbaf7f960ce649806eb39cc703f
F test/tclsqlite.test de670beccf910163bf49973a3a96eaa00cdf127e
F test/temptable.test 63a16e3ad19adf073cfbcdf7624c92ac5236522c
F test/tester.tcl 1ff1170dd4203d87f572871080cdb64330dade99
F test/thread1.test 776c9e459b75ba905193b351926ac4019b049f35
@ -248,7 +248,7 @@ F www/tclsqlite.tcl 560ecd6a916b320e59f2917317398f3d59b7cc25
F www/vdbe.tcl 59288db1ac5c0616296b26dce071c36cb611dfe9
F www/version3.tcl 092a01f5ef430d2c4acc0ae558d74c4bb89638a0
F www/whentouse.tcl a8335bce47cc2fddb07f19052cb0cb4d9129a8e4
P 23e5bed1c5062f0f639751f89873bf1a277547bd
R e40cf5a15ff3721d6f9f87371f66f8fc
P d53047cbbc4e618c7bb5161b6f82876bb113db25
R 303fc0394eb00108b3dd869bec641bd9
U drh
Z 9268fa6b52f2c5d13e0dc61c8a84d6ef
Z 3769d67a37ed8f4ac0e4d151ebaba45a

View File

@ -1 +1 @@
d53047cbbc4e618c7bb5161b6f82876bb113db25
f323e4f86a08fe6448cbd4ff7cab459e8039d9f1

View File

@ -11,7 +11,7 @@
*************************************************************************
** A TCL Interface to SQLite
**
** $Id: tclsqlite.c,v 1.104 2004/09/06 17:24:13 drh Exp $
** $Id: tclsqlite.c,v 1.105 2004/09/07 13:20:35 drh Exp $
*/
#ifndef NO_TCL /* Omit this whole file if TCL is unavailable */
@ -73,35 +73,6 @@ struct SqliteDb {
Tcl_Obj *pCollateNeeded; /* Collation needed script */
};
/*
** This is a second alternative callback for database queries. A the
** first column of the first row of the result is made the TCL result.
*/
static int DbEvalCallback3(
void *clientData, /* An instance of CallbackData */
int nCol, /* Number of columns in the result */
char ** azCol, /* Data for each column */
char ** azN /* Name for each column */
){
Tcl_Interp *interp = (Tcl_Interp*)clientData;
Tcl_Obj *pElem;
if( azCol==0 ) return 1;
if( nCol==0 ) return 1;
#ifdef UTF_TRANSLATION_NEEDED
{
Tcl_DString dCol;
Tcl_DStringInit(&dCol);
Tcl_ExternalToUtfDString(NULL, azCol[0], -1, &dCol);
pElem = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
Tcl_DStringFree(&dCol);
}
#else
pElem = Tcl_NewStringObj(azCol[0], -1);
#endif
Tcl_SetObjResult(interp, pElem);
return 1;
}
/*
** TCL calls this procedure when an sqlite3 database command is
** deleted.
@ -496,48 +467,6 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
break;
}
/* $db progress ?N CALLBACK?
**
** Invoke the given callback every N virtual machine opcodes while executing
** queries.
*/
case DB_PROGRESS: {
if( objc==2 ){
if( pDb->zProgress ){
Tcl_AppendResult(interp, pDb->zProgress, 0);
}
}else if( objc==4 ){
char *zProgress;
int len;
int N;
if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
return TCL_ERROR;
};
if( pDb->zProgress ){
Tcl_Free(pDb->zProgress);
}
zProgress = Tcl_GetStringFromObj(objv[3], &len);
if( zProgress && len>0 ){
pDb->zProgress = Tcl_Alloc( len + 1 );
strcpy(pDb->zProgress, zProgress);
}else{
pDb->zProgress = 0;
}
#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
if( pDb->zProgress ){
pDb->interp = interp;
sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
}else{
sqlite3_progress_handler(pDb->db, 0, 0, 0);
}
#endif
}else{
Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
return TCL_ERROR;
}
break;
}
/* $db changes
**
** Return the number of rows that were modified, inserted, or deleted by
@ -685,13 +614,18 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
/*
** $db eval $sql ?array? ?{ ...code... }?
** $db onecolumn $sql
**
** The SQL statement in $sql is evaluated. For each row, the values are
** placed in elements of the array named "array" and ...code... is executed.
** If "array" and "code" are omitted, then no callback is every invoked.
** 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: {
char const *zSql; /* Next SQL statement to execute */
char const *zLeft; /* What is left after first stmt in zSql */
@ -701,13 +635,21 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
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 */
Tcl_Obj *pRet = Tcl_NewObj();
Tcl_IncrRefCount(pRet);
if( objc<3 || objc>5 ){
Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?");
return TCL_ERROR;
if( choice==DB_ONECOLUMN ){
if( objc!=3 ){
Tcl_WrongNumArgs(interp, 2, objv, "SQL");
return TCL_ERROR;
}
pRet = 0;
}else{
if( objc<3 || objc>5 ){
Tcl_WrongNumArgs(interp, 2, objv, "SQL ?ARRAY-NAME? ?SCRIPT?");
return TCL_ERROR;
}
pRet = Tcl_NewObj();
Tcl_IncrRefCount(pRet);
}
if( objc==3 ){
pArray = pScript = 0;
@ -784,7 +726,6 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
}
}
}
/* Compute column names */
nCol = sqlite3_column_count(pStmt);
@ -848,6 +789,12 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
}else{
Tcl_ObjSetVar2(interp, pArray, apColName[i], pVal, 0);
}
}else if( choice==DB_ONECOLUMN ){
if( pRet==0 ){
pRet = pVal;
Tcl_IncrRefCount(pRet);
}
goto end_step;
}else{
Tcl_ListObjAppendElement(interp, pRet, pVal);
}
@ -858,6 +805,7 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
if( rc!=TCL_ERROR ) rc = TCL_OK;
}
}
end_step:
/* Free the column name objects */
if( pScript ){
@ -892,10 +840,12 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
}
Tcl_DecrRefCount(objv[2]);
if( rc==TCL_OK ){
Tcl_SetObjResult(interp, pRet);
if( pRet ){
if( rc==TCL_OK ){
Tcl_SetObjResult(interp, pRet);
}
Tcl_DecrRefCount(pRet);
}
Tcl_DecrRefCount(pRet);
break;
}
@ -949,29 +899,48 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){
}
/*
** $db onecolumn SQL
**
** Return a single column from a single row of the given SQL query.
** The DB_ONECOLUMN method is implemented together with DB_EVAL.
*/
case DB_ONECOLUMN: {
char *zSql;
char *zErrMsg = 0;
if( objc!=3 ){
Tcl_WrongNumArgs(interp, 2, objv, "SQL");
/* $db progress ?N CALLBACK?
**
** Invoke the given callback every N virtual machine opcodes while executing
** queries.
*/
case DB_PROGRESS: {
if( objc==2 ){
if( pDb->zProgress ){
Tcl_AppendResult(interp, pDb->zProgress, 0);
}
}else if( objc==4 ){
char *zProgress;
int len;
int N;
if( TCL_OK!=Tcl_GetIntFromObj(interp, objv[2], &N) ){
return TCL_ERROR;
};
if( pDb->zProgress ){
Tcl_Free(pDb->zProgress);
}
zProgress = Tcl_GetStringFromObj(objv[3], &len);
if( zProgress && len>0 ){
pDb->zProgress = Tcl_Alloc( len + 1 );
strcpy(pDb->zProgress, zProgress);
}else{
pDb->zProgress = 0;
}
#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
if( pDb->zProgress ){
pDb->interp = interp;
sqlite3_progress_handler(pDb->db, N, DbProgressHandler, pDb);
}else{
sqlite3_progress_handler(pDb->db, 0, 0, 0);
}
#endif
}else{
Tcl_WrongNumArgs(interp, 2, objv, "N CALLBACK");
return TCL_ERROR;
}
zSql = Tcl_GetStringFromObj(objv[2], 0);
rc = sqlite3_exec(pDb->db, zSql, DbEvalCallback3, interp, &zErrMsg);
if( rc==SQLITE_ABORT ){
rc = SQLITE_OK;
}else if( zErrMsg ){
Tcl_SetResult(interp, zErrMsg, TCL_VOLATILE);
free(zErrMsg);
rc = TCL_ERROR;
}else if( rc!=SQLITE_OK ){
Tcl_AppendResult(interp, sqlite3ErrStr(rc), 0);
rc = TCL_ERROR;
}
break;
}

View File

@ -15,7 +15,7 @@
# 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.30 2004/08/20 18:34:20 drh Exp $
# $Id: tclsqlite.test,v 1.31 2004/09/07 13:20:35 drh Exp $
set testdir [file dirname $argv0]
source $testdir/tester.tcl
@ -170,6 +170,24 @@ do_test tcl-3.4 {
set rc [catch {db onecolumn {SELECT bogus}} errmsg]
lappend rc $errmsg
} {1 {no such column: bogus}}
do_test tcl-3.5 {
set b 50
set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]
lappend rc $msg
} {0 41}
do_test tcl-3.6 {
set b 500
set rc [catch {db one {SELECT * FROM t1 WHERE b>$b}} msg]
lappend rc $msg
} {0 {}}
do_test tcl-3.7 {
set b 500
set rc [catch {db one {
INSERT INTO t1 VALUES(99,510);
SELECT * FROM t1 WHERE b>$b
}} msg]
lappend rc $msg
} {0 99}
# Turn the busy handler on and off
#