Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Update the TCL wrapper to provide a non-NULL objProc pointer to the Tcl_NRCreateCommand() interface. The TCL gurus say this is needed to support legacy TCL extensions. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
1b3cfa01dd7fb9a48f0008f5afd974db |
| User & Date: | drh 2009-10-13 18:38:34 |
Context
|
2009-10-13
| ||
| 18:49 | Fix a typo in the test script added for ticket [5ee23731f15]. (check-in: d0f55b5c user: drh tags: trunk) | |
| 18:38 | Update the TCL wrapper to provide a non-NULL objProc pointer to the Tcl_NRCreateCommand() interface. The TCL gurus say this is needed to support legacy TCL extensions. (check-in: 1b3cfa01 user: drh tags: trunk) | |
| 15:42 | Add a test case to verify that ticket [5ee23731f15] has been fixed. (check-in: f894ebf8 user: drh tags: trunk) | |
Changes
Changes to src/tclsqlite.c.
1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 .... 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 .... 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 .... 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 |
** If using Tcl version 8.6 or greater, use the NR functions to avoid
** recursive evalution of scripts by the [db eval] and [db trans]
** commands. Even if the headers used while compiling the extension
** are 8.6 or newer, the code still tests the Tcl version at runtime.
** 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)
static int DbUseNre(void){
int major, minor;
Tcl_GetVersion(&major, &minor, 0, 0);
return( (major==8 && minor>=6) || major>8 );
}
#else
/*
................................................................................
** used, so DbUseNre() to always return zero. Add #defines for the other
** Tcl_NRxxx() functions to prevent them from causing compilation errors,
** even though the only invocations of them are within conditional blocks
** of the form:
**
** if( DbUseNre() ) { ... }
*/
# define DbUseNre() 0
# define Tcl_NRAddCallback(a,b,c,d,e,f) 0
# define Tcl_NREvalObj(a,b,c) 0
# define Tcl_NRCreateCommand(a,b,c,d,e,f) 0
#endif
/*
................................................................................
}
} /* End of the SWITCH statement */
return rc;
}
/*
** sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN?
** ?-create BOOLEAN? ?-nomutex BOOLEAN?
**
** This is the main Tcl command. When the "sqlite" Tcl command is
** invoked, this routine runs to process that command.
**
................................................................................
sqlite3_free(zErrMsg);
return TCL_ERROR;
}
p->maxStmt = NUM_PREPARED_STMTS;
p->interp = interp;
zArg = Tcl_GetStringFromObj(objv[1], 0);
if( DbUseNre() ){
Tcl_NRCreateCommand(interp, zArg, 0, DbObjCmd, (char*)p, DbDeleteCmd);
}else{
Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd);
}
return TCL_OK;
}
/*
|
> > > > > > > > > > > > > > > > > | > |
1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 .... 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 .... 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 .... 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 |
** If using Tcl version 8.6 or greater, use the NR functions to avoid ** recursive evalution of scripts by the [db eval] and [db trans] ** commands. Even if the headers used while compiling the extension ** are 8.6 or newer, the code still tests the Tcl version at runtime. ** 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); return( (major==8 && minor>=6) || major>8 ); } #else /* ................................................................................ ** used, so DbUseNre() to always return zero. Add #defines for the other ** Tcl_NRxxx() functions to prevent them from causing compilation errors, ** even though the only invocations of them are within conditional blocks ** of the form: ** ** 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 # define Tcl_NRCreateCommand(a,b,c,d,e,f) 0 #endif /* ................................................................................ } } /* End of the SWITCH statement */ 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? ** ** This is the main Tcl command. When the "sqlite" Tcl command is ** invoked, this routine runs to process that command. ** ................................................................................ sqlite3_free(zErrMsg); return TCL_ERROR; } p->maxStmt = NUM_PREPARED_STMTS; p->interp = interp; zArg = Tcl_GetStringFromObj(objv[1], 0); if( DbUseNre() ){ Tcl_NRCreateCommand(interp, zArg, DbObjCmdAdaptor, DbObjCmd, (char*)p, DbDeleteCmd); }else{ Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd); } return TCL_OK; } /* |
Changes to src/test1.c.
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
....
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
|
}
rc = sqlite3_unlock_notify(db, test_unlock_notify_cb, (void *)interp);
Tcl_SetResult(interp, (char *)t1ErrorName(rc), TCL_STATIC);
return TCL_OK;
}
#endif
/*
** Register commands with the TCL interpreter.
*/
int Sqlitetest1_Init(Tcl_Interp *interp){
extern int sqlite3_search_count;
extern int sqlite3_found_count;
................................................................................
{ "sqlite3_enable_load_extension", test_enable_load, 0},
{ "sqlite3_extended_result_codes", test_extended_result_codes, 0},
{ "sqlite3_limit", test_limit, 0},
{ "save_prng_state", save_prng_state, 0 },
{ "restore_prng_state", restore_prng_state, 0 },
{ "reset_prng_state", reset_prng_state, 0 },
/* sqlite3_column_*() API */
{ "sqlite3_column_count", test_column_count ,0 },
{ "sqlite3_data_count", test_data_count ,0 },
{ "sqlite3_column_type", test_column_type ,0 },
{ "sqlite3_column_blob", test_column_blob ,0 },
{ "sqlite3_column_double", test_column_double ,0 },
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
....
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
|
} rc = sqlite3_unlock_notify(db, test_unlock_notify_cb, (void *)interp); Tcl_SetResult(interp, (char *)t1ErrorName(rc), TCL_STATIC); return TCL_OK; } #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. */ int Sqlitetest1_Init(Tcl_Interp *interp){ extern int sqlite3_search_count; extern int sqlite3_found_count; ................................................................................ { "sqlite3_enable_load_extension", test_enable_load, 0}, { "sqlite3_extended_result_codes", test_extended_result_codes, 0}, { "sqlite3_limit", test_limit, 0}, { "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 }, { "sqlite3_data_count", test_data_count ,0 }, { "sqlite3_column_type", test_column_type ,0 }, { "sqlite3_column_blob", test_column_blob ,0 }, { "sqlite3_column_double", test_column_double ,0 }, |
Changes to test/tclsqlite.test.
565 566 567 568 569 570 571 572 573 574 575 576 577 578 |
} {1}
do_test tcl-11.2 {
db exists {SELECT 0 FROM t4 WHERE x==6}
} {1}
do_test tcl-11.3 {
db exists {SELECT 1 FROM t4 WHERE x==8}
} {0}
do_test tcl-12.1 {
unset -nocomplain a b c version
set version [db version]
scan $version "%d.%d.%d" a b c
expr $a*1000000 + $b*1000 + $c
} [sqlite3_libversion_number]
|
> > > |
565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 |
} {1}
do_test tcl-11.2 {
db exists {SELECT 0 FROM t4 WHERE x==6}
} {1}
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
set version [db version]
scan $version "%d.%d.%d" a b c
expr $a*1000000 + $b*1000 + $c
} [sqlite3_libversion_number]
|