/ Check-in [1b3cfa01]
Login

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: 1b3cfa01dd7fb9a48f0008f5afd974db61c30cff
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
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to src/tclsqlite.c.

  1411   1411   ** If using Tcl version 8.6 or greater, use the NR functions to avoid
  1412   1412   ** recursive evalution of scripts by the [db eval] and [db trans]
  1413   1413   ** commands. Even if the headers used while compiling the extension
  1414   1414   ** are 8.6 or newer, the code still tests the Tcl version at runtime.
  1415   1415   ** This allows stubs-enabled builds to be used with older Tcl libraries.
  1416   1416   */
  1417   1417   #if TCL_MAJOR_VERSION>8 || (TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION>=6)
         1418  +# define SQLITE_TCL_NRE 1
  1418   1419   static int DbUseNre(void){
  1419   1420     int major, minor;
  1420   1421     Tcl_GetVersion(&major, &minor, 0, 0);
  1421   1422     return( (major==8 && minor>=6) || major>8 );
  1422   1423   }
  1423   1424   #else
  1424   1425   /* 
................................................................................
  1426   1427   ** used, so DbUseNre() to always return zero. Add #defines for the other
  1427   1428   ** Tcl_NRxxx() functions to prevent them from causing compilation errors,
  1428   1429   ** even though the only invocations of them are within conditional blocks 
  1429   1430   ** of the form:
  1430   1431   **
  1431   1432   **   if( DbUseNre() ) { ... }
  1432   1433   */
         1434  +# define SQLITE_TCL_NRE 0
  1433   1435   # define DbUseNre() 0
  1434   1436   # define Tcl_NRAddCallback(a,b,c,d,e,f) 0
  1435   1437   # define Tcl_NREvalObj(a,b,c) 0
  1436   1438   # define Tcl_NRCreateCommand(a,b,c,d,e,f) 0
  1437   1439   #endif
  1438   1440   
  1439   1441   /*
................................................................................
  2760   2762     }
  2761   2763   
  2762   2764   
  2763   2765     } /* End of the SWITCH statement */
  2764   2766     return rc;
  2765   2767   }
  2766   2768   
         2769  +#if SQLITE_TCL_NRE
         2770  +/*
         2771  +** Adaptor that provides an objCmd interface to the NRE-enabled
         2772  +** interface implementation.
         2773  +*/
         2774  +static int DbObjCmdAdaptor(
         2775  +  void *cd,
         2776  +  Tcl_Interp *interp,
         2777  +  int objc,
         2778  +  Tcl_Obj *const*objv
         2779  +){
         2780  +  return Tcl_NRCallObjProc(interp, DbObjCmd, cd, objc, objv);
         2781  +}
         2782  +#endif /* SQLITE_TCL_NRE */
         2783  +
  2767   2784   /*
  2768   2785   **   sqlite3 DBNAME FILENAME ?-vfs VFSNAME? ?-key KEY? ?-readonly BOOLEAN?
  2769   2786   **                           ?-create BOOLEAN? ?-nomutex BOOLEAN?
  2770   2787   **
  2771   2788   ** This is the main Tcl command.  When the "sqlite" Tcl command is
  2772   2789   ** invoked, this routine runs to process that command.
  2773   2790   **
................................................................................
  2903   2920       sqlite3_free(zErrMsg);
  2904   2921       return TCL_ERROR;
  2905   2922     }
  2906   2923     p->maxStmt = NUM_PREPARED_STMTS;
  2907   2924     p->interp = interp;
  2908   2925     zArg = Tcl_GetStringFromObj(objv[1], 0);
  2909   2926     if( DbUseNre() ){
  2910         -    Tcl_NRCreateCommand(interp, zArg, 0, DbObjCmd, (char*)p, DbDeleteCmd);
         2927  +    Tcl_NRCreateCommand(interp, zArg, DbObjCmdAdaptor, DbObjCmd,
         2928  +                        (char*)p, DbDeleteCmd);
  2911   2929     }else{
  2912   2930       Tcl_CreateObjCommand(interp, zArg, DbObjCmd, (char*)p, DbDeleteCmd);
  2913   2931     }
  2914   2932     return TCL_OK;
  2915   2933   }
  2916   2934   
  2917   2935   /*

Changes to src/test1.c.

  4863   4863     }
  4864   4864     rc = sqlite3_unlock_notify(db, test_unlock_notify_cb, (void *)interp);
  4865   4865     Tcl_SetResult(interp, (char *)t1ErrorName(rc), TCL_STATIC);
  4866   4866     return TCL_OK;
  4867   4867   }
  4868   4868   #endif
  4869   4869   
         4870  +
         4871  +/*
         4872  +**     tcl_objproc COMMANDNAME ARGS...
         4873  +**
         4874  +** Run a TCL command using its objProc interface.  Throw an error if
         4875  +** the command has no objProc interface.
         4876  +*/
         4877  +static int runAsObjProc(
         4878  +  void * clientData,
         4879  +  Tcl_Interp *interp,
         4880  +  int objc,
         4881  +  Tcl_Obj *CONST objv[]
         4882  +){
         4883  +  Tcl_CmdInfo cmdInfo;
         4884  +  if( objc<2 ){
         4885  +    Tcl_WrongNumArgs(interp, 1, objv, "COMMAND ...");
         4886  +    return TCL_ERROR;
         4887  +  }
         4888  +  if( !Tcl_GetCommandInfo(interp, Tcl_GetString(objv[1]), &cmdInfo) ){
         4889  +    Tcl_AppendResult(interp, "command not found: ",
         4890  +           Tcl_GetString(objv[1]), (char*)0);
         4891  +    return TCL_ERROR;
         4892  +  }
         4893  +  if( cmdInfo.objProc==0 ){
         4894  +    Tcl_AppendResult(interp, "command has no objProc: ",
         4895  +           Tcl_GetString(objv[1]), (char*)0);
         4896  +    return TCL_ERROR;
         4897  +  }
         4898  +  return cmdInfo.objProc(cmdInfo.objClientData, interp, objc-1, objv+1);
         4899  +}
         4900  +
  4870   4901   
  4871   4902   /*
  4872   4903   ** Register commands with the TCL interpreter.
  4873   4904   */
  4874   4905   int Sqlitetest1_Init(Tcl_Interp *interp){
  4875   4906     extern int sqlite3_search_count;
  4876   4907     extern int sqlite3_found_count;
................................................................................
  4980   5011        { "sqlite3_enable_load_extension", test_enable_load,        0},
  4981   5012        { "sqlite3_extended_result_codes", test_extended_result_codes, 0},
  4982   5013        { "sqlite3_limit",                 test_limit,                 0},
  4983   5014   
  4984   5015        { "save_prng_state",               save_prng_state,    0 },
  4985   5016        { "restore_prng_state",            restore_prng_state, 0 },
  4986   5017        { "reset_prng_state",              reset_prng_state,   0 },
         5018  +     { "tcl_objproc",                   runAsObjProc,       0 },
  4987   5019   
  4988   5020        /* sqlite3_column_*() API */
  4989   5021        { "sqlite3_column_count",          test_column_count  ,0 },
  4990   5022        { "sqlite3_data_count",            test_data_count    ,0 },
  4991   5023        { "sqlite3_column_type",           test_column_type   ,0 },
  4992   5024        { "sqlite3_column_blob",           test_column_blob   ,0 },
  4993   5025        { "sqlite3_column_double",         test_column_double ,0 },

Changes to test/tclsqlite.test.

   565    565   } {1}
   566    566   do_test tcl-11.2 {
   567    567     db exists {SELECT 0 FROM t4 WHERE x==6}
   568    568   } {1}
   569    569   do_test tcl-11.3 {
   570    570     db exists {SELECT 1 FROM t4 WHERE x==8}
   571    571   } {0}
          572  +do_test tcl-11.3.1 {
          573  +  tcl_objproc db exists {SELECT 1 FROM t4 WHERE x==8}
          574  +} {0}
   572    575   
   573    576   do_test tcl-12.1 {
   574    577     unset -nocomplain a b c version
   575    578     set version [db version]
   576    579     scan $version "%d.%d.%d" a b c
   577    580     expr $a*1000000 + $b*1000 + $c
   578    581   } [sqlite3_libversion_number]