diff --git a/manifest b/manifest index d847c0fa1f..9df2a55d40 100644 --- a/manifest +++ b/manifest @@ -1,8 +1,8 @@ -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 -C Add\sa\stest\scase\sto\sverify\sthat\sticket\s[5ee23731f15]\shas\sbeen\sfixed. -D 2009-10-13T15:42:49 +C Update\sthe\sTCL\swrapper\sto\sprovide\sa\snon-NULL\sobjProc\spointer\sto\sthe\nTcl_NRCreateCommand()\sinterface.\s\sThe\sTCL\sgurus\ssay\sthis\sis\sneeded\sto\nsupport\slegacy\sTCL\sextensions. +D 2009-10-13T18:38:34 F Makefile.arm-wince-mingw32ce-gcc fcd5e9cd67fe88836360bb4f9ef4cb7f8e2fb5a0 F Makefile.in 4ca3f1dd6efa2075bcb27f4dc43eef749877740d F Makefile.linux-gcc d53183f4aa6a9192d249731c90dbdffbd2c68654 @@ -171,8 +171,8 @@ F src/sqliteInt.h 44cded4d6b78fe5fb5339454c44e51c64b7d8ed8 F src/sqliteLimit.h 38b2fffcd01faeaeaadea71b2b47695a81580c8b F src/status.c 237b193efae0cf6ac3f0817a208de6c6c6ef6d76 F src/table.c cc86ad3d6ad54df7c63a3e807b5783c90411a08d -F src/tclsqlite.c 868d62910bc6b41c49554482bdcc1590efc01f3c -F src/test1.c 9bd64834314b67345855c314dc479bc12596a9b7 +F src/tclsqlite.c b91a03d52d39eda4392931ac4ebd421b9234c2be +F src/test1.c 4da992ff460cba2167e67df3ba28ad66afebfe91 F src/test2.c 0de743ec8890ca4f09e0bce5d6d5a681f5957fec F src/test3.c 2445c2beb5e7a0c91fd8136dc1339ec369a24898 F src/test4.c b5fd530f02a6a0dbffb23be202168a690985dedd @@ -574,7 +574,7 @@ F test/substr.test 18f57c4ca8a598805c4d64e304c418734d843c1a F test/sync.test ded6b39d8d8ca3c0c5518516c6371b3316d3e3a3 F test/table.test bf102a5669c4db7a41330802f24a4a81a4204f83 F test/tableapi.test 7262a8cbaa9965d429f1cbd2747edc185fa56516 -F test/tclsqlite.test 8b1150d0486c4848c70d96422513a91c5342be0e +F test/tclsqlite.test bf4227eb236a4c097aa7974a2bf7d3225acf34be F test/tempdb.test 1bf52da28a9c24e29717362a87722dff08feb72b F test/temptable.test f42121a0d29a62f00f93274464164177ab1cc24a F test/temptrigger.test b0273db072ce5f37cf19140ceb1f0d524bbe9f05 @@ -760,14 +760,14 @@ F tool/speedtest2.tcl ee2149167303ba8e95af97873c575c3e0fab58ff F tool/speedtest8.c 2902c46588c40b55661e471d7a86e4dd71a18224 F tool/speedtest8inst1.c 293327bc76823f473684d589a8160bde1f52c14e F tool/vdbe-compress.tcl d70ea6d8a19e3571d7ab8c9b75cba86d1173ff0f -P bc1101179abb4577417c971a7e4fbacde50e19a2 -R cf79a35faaf03c97023abaa3e5d4feea +P f894ebf86d6bafcd1461f104f5f677b3b6a3aa1a +R 78a04730a8c7b7cebc1d3f47c09f5bfa U drh -Z 47b9b31e4d3789db641a51e6b331e60b +Z 3c7266f38200d8f31bd2e5d5281dbd3f -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.6 (GNU/Linux) -iD8DBQFK1J/8oxKgR168RlERAuH0AJ9TgUqhzQCMtbf9WjHdu/bdlto6igCcCET5 -2WPnZ+F+7rlkdtMtAJR9Ka8= -=MjzV +iD8DBQFK1MktoxKgR168RlERAgM/AJ4tDelhAOqaGTX4bLzzaDCACDLesACgirtD +K1/iBwAIRLX5JOdd5czm15s= +=ULek -----END PGP SIGNATURE----- diff --git a/manifest.uuid b/manifest.uuid index ba7a288b29..349ef63700 100644 --- a/manifest.uuid +++ b/manifest.uuid @@ -1 +1 @@ -f894ebf86d6bafcd1461f104f5f677b3b6a3aa1a \ No newline at end of file +1b3cfa01dd7fb9a48f0008f5afd974db61c30cff \ No newline at end of file diff --git a/src/tclsqlite.c b/src/tclsqlite.c index dea1d90df4..5f5517ac2b 100644 --- a/src/tclsqlite.c +++ b/src/tclsqlite.c @@ -1415,6 +1415,7 @@ static Tcl_Obj *dbEvalColumnValue(DbEvalContext *p, int iCol){ ** This allows stubs-enabled builds to be used with older Tcl libraries. */ #if TCL_MAJOR_VERSION>8 || (TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION>=6) +# define SQLITE_TCL_NRE 1 static int DbUseNre(void){ int major, minor; Tcl_GetVersion(&major, &minor, 0, 0); @@ -1430,6 +1431,7 @@ static int DbUseNre(void){ ** ** if( DbUseNre() ) { ... } */ +# define SQLITE_TCL_NRE 0 # define DbUseNre() 0 # define Tcl_NRAddCallback(a,b,c,d,e,f) 0 # define Tcl_NREvalObj(a,b,c) 0 @@ -2764,6 +2766,21 @@ static int DbObjCmd(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){ return rc; } +#if SQLITE_TCL_NRE +/* +** Adaptor that provides an objCmd interface to the NRE-enabled +** interface implementation. +*/ +static int DbObjCmdAdaptor( + void *cd, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const*objv +){ + return Tcl_NRCallObjProc(interp, DbObjCmd, cd, objc, objv); +} +#endif /* SQLITE_TCL_NRE */ + /* ** sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN? ** ?-create BOOLEAN? ?-nomutex BOOLEAN? @@ -2907,7 +2924,8 @@ static int DbMain(void *cd, Tcl_Interp *interp, int objc,Tcl_Obj *const*objv){ p->interp = interp; zArg = Tcl_GetStringFromObj(objv[1], 0); if( DbUseNre() ){ - Tcl_NRCreateCommand(interp, zArg, 0, DbObjCmd, (char*)p, DbDeleteCmd); + Tcl_NRCreateCommand(interp, zArg, DbObjCmdAdaptor, DbObjCmd, + (char*)p, DbDeleteCmd); }else{ Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd); } diff --git a/src/test1.c b/src/test1.c index aa28a3dfff..ac4f27282f 100644 --- a/src/test1.c +++ b/src/test1.c @@ -4868,6 +4868,37 @@ static int test_unlock_notify( #endif +/* +** tcl_objproc COMMANDNAME ARGS... +** +** Run a TCL command using its objProc interface. Throw an error if +** the command has no objProc interface. +*/ +static int runAsObjProc( + void * clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *CONST objv[] +){ + Tcl_CmdInfo cmdInfo; + if( objc<2 ){ + Tcl_WrongNumArgs(interp, 1, objv, "COMMAND ..."); + return TCL_ERROR; + } + if( !Tcl_GetCommandInfo(interp, Tcl_GetString(objv[1]), &cmdInfo) ){ + Tcl_AppendResult(interp, "command not found: ", + Tcl_GetString(objv[1]), (char*)0); + return TCL_ERROR; + } + if( cmdInfo.objProc==0 ){ + Tcl_AppendResult(interp, "command has no objProc: ", + Tcl_GetString(objv[1]), (char*)0); + return TCL_ERROR; + } + return cmdInfo.objProc(cmdInfo.objClientData, interp, objc-1, objv+1); +} + + /* ** Register commands with the TCL interpreter. */ @@ -4984,6 +5015,7 @@ int Sqlitetest1_Init(Tcl_Interp *interp){ { "save_prng_state", save_prng_state, 0 }, { "restore_prng_state", restore_prng_state, 0 }, { "reset_prng_state", reset_prng_state, 0 }, + { "tcl_objproc", runAsObjProc, 0 }, /* sqlite3_column_*() API */ { "sqlite3_column_count", test_column_count ,0 }, diff --git a/test/tclsqlite.test b/test/tclsqlite.test index e752aa9fac..6bae7f204e 100644 --- a/test/tclsqlite.test +++ b/test/tclsqlite.test @@ -569,6 +569,9 @@ do_test tcl-11.2 { do_test tcl-11.3 { db exists {SELECT 1 FROM t4 WHERE x==8} } {0} +do_test tcl-11.3.1 { + tcl_objproc db exists {SELECT 1 FROM t4 WHERE x==8} +} {0} do_test tcl-12.1 { unset -nocomplain a b c version