Avoid using Tcl command [clock] in testrunner.tcl.

FossilOrigin-Name: b2faf9289f6fbbcd4491e1b063da731b35aeed9ff1fc97f64798e99cac847b4a

diff --git a/manifest b/manifest
index 23a040a3a53ed91f40cfd5ffa241ac84d6359714..ffbb183f7229a34fdba1d52a285beb31401e7ac0 100644 (file)
--- a/manifest
+++ b/manifest
@@ -1,5 +1,5 @@
-C Do\snot\srun\stest\sscript\spendingrace.test\sas\spart\sof\sthe\sinmemory_journal\spermutation.
-D 2023-02-02T20:15:42.613
+C Avoid\susing\sTcl\scommand\s[clock]\sin\stestrunner.tcl.
+D 2023-02-03T11:32:51.147
 F .fossil-settings/empty-dirs dbb81e8fc0401ac46a1491ab34a7f2c7c0452f2f06b54ebb845d024ca8283ef1
 F .fossil-settings/ignore-glob 35175cdfcf539b2318cb04a9901442804be81cd677d8b889fcc9149c21f239ea
 F LICENSE.md df5091916dbb40e6e9686186587125e1b2ff51f022cc334e886c19a0e9982724
@@ -675,7 +675,7 @@ F src/test_superlock.c 4839644b9201da822f181c5bc406c0b2385f672e
 F src/test_syscall.c 1073306ba2e9bfc886771871a13d3de281ed3939
 F src/test_tclsh.c 7dd98be675a1dc0d1fd302b8247bab992c909db384df054381a2279ad76f9b0e
 F src/test_tclvar.c 33ff42149494a39c5fbb0df3d25d6fafb2f668888e41c0688d07273dcb268dfc
-F src/test_thread.c 269ea9e1fa5828dba550eb26f619aa18aedbc29fd92f8a5f6b93521fbb74a61c
+F src/test_thread.c 7ddcf0c8b79fa3c1d172f82f322302c963d923cdb503c6171f3c8081586d0b01
 F src/test_vdbecov.c f60c6f135ec42c0de013a1d5136777aa328a776d33277f92abac648930453d43
 F src/test_vfs.c 193c18da3dbf62a0e33ae7a240bbef938a50846672ee947664512b77d853fe81
 F src/test_vfstrace.c bab9594adc976cbe696ff3970728830b4c5ed698
@@ -1565,7 +1565,7 @@ F test/temptable2.test 76821347810ecc88203e6ef0dd6897b6036ac788e9dd3e6b04fd4d163
 F test/temptable3.test d11a0974e52b347e45ee54ef1923c91ed91e4637
 F test/temptrigger.test 38f0ca479b1822d3117069e014daabcaacefffcc
 F test/tester.tcl 8d54d40a55e12554b4509bc12078b201b233c8e842a7543629094a21b1ba956d
-F test/testrunner.tcl 24d785dcad30a53838ad64aac056b49551049eba3b3c27ae3659be3fc157b213
+F test/testrunner.tcl ef21c2f377e4a6648252afbdd7a330256fa075eb3f1f12a4af4fffabb132cdef
 F test/testrunner_data.tcl 38e2f2b2eb3033b58b4f7428affb5d627719e97ee166c8b95296c39ffca6c849
 F test/thread001.test a0985c117eab62c0c65526e9fa5d1360dd1cac5b03bde223902763274ce21899
 F test/thread002.test c24c83408e35ba5a952a3638b7ac03ccdf1ce4409289c54a050ac4c5f1de7502
@@ -2047,8 +2047,8 @@ F vsixtest/vsixtest.tcl 6a9a6ab600c25a91a7acc6293828957a386a8a93
 F vsixtest/vsixtest.vcxproj.data 2ed517e100c66dc455b492e1a33350c1b20fbcdc
 F vsixtest/vsixtest.vcxproj.filters 37e51ffedcdb064aad6ff33b6148725226cd608e
 F vsixtest/vsixtest_TemporaryKey.pfx e5b1b036facdb453873e7084e1cae9102ccc67a0
-P e45d34656a110f85671d8b5d33f0d6d807fd64dfef5777fefba22ac6836f0e86
-R 53b5e11040e0762552b432c9c907db23
+P 69d934a1bfad86f3f60dab146db539645f5735f1bdb07dfe3a3d88828a03390b
+R 2c8cdf901157932d2f3f5be2f780ac84
 U dan
-Z cfccc793dc6ba86f29efadbd3358e320
+Z 4428f02730b2f2d17ac513e2b892f834
 # Remove this line to create a well-formed Fossil manifest.

diff --git a/manifest.uuid b/manifest.uuid
index 8e96d4a27c40dd268c61f0a0f33ad2cf4bcc037d..42d5d121e10b6b1d3872ba0736521560d6e07dc4 100644 (file)
--- a/manifest.uuid
+++ b/manifest.uuid
@@ -1 +1 @@
-69d934a1bfad86f3f60dab146db539645f5735f1bdb07dfe3a3d88828a03390b
\ No newline at end of file
+b2faf9289f6fbbcd4491e1b063da731b35aeed9ff1fc97f64798e99cac847b4a
\ No newline at end of file

diff --git a/src/test_thread.c b/src/test_thread.c
index de0fdb434684b3b522a9dde0f181db2bc1453e87..126fd983693474068ecd198969bf78088179e71f 100644 (file)
--- a/src/test_thread.c
+++ b/src/test_thread.c
@@ -384,6 +384,27 @@ static int SQLITE_TCLAPI clock_seconds_proc(
   return TCL_OK;
 }
 
+/*
+** The [clock_milliseconds] command. This is more or less the same as the
+** regular tcl [clock milliseconds]. 
+*/ 
+static int SQLITE_TCLAPI clock_milliseconds_proc(
+  ClientData clientData,
+  Tcl_Interp *interp,
+  int objc,
+  Tcl_Obj *CONST objv[]
+){
+  Tcl_Time now;
+  Tcl_GetTime(&now);
+  Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
+    ((Tcl_WideInt)now.sec * 1000) + (now.usec / 1000)
+  ));
+  UNUSED_PARAMETER(clientData);
+  UNUSED_PARAMETER(objc);
+  UNUSED_PARAMETER(objv);
+  return TCL_OK;
+}
+
 /*************************************************************************
 ** This block contains the implementation of the [sqlite3_blocking_step]
 ** command available to threads created by [sqlthread spawn] commands. It
@@ -617,15 +638,26 @@ static int SQLITE_TCLAPI blocking_prepare_v2_proc(
 ** Register commands with the TCL interpreter.
 */
 int SqlitetestThread_Init(Tcl_Interp *interp){
-  Tcl_CreateObjCommand(interp, "sqlthread", sqlthread_proc, 0, 0);
-  Tcl_CreateObjCommand(interp, "clock_seconds", clock_seconds_proc, 0, 0);
+  struct TclCmd {
+    int (*xProc)(void*, Tcl_Interp*, int, Tcl_Obj*const*);
+    const char *zName;
+    int iCtx;
+  } aCmd[] = {
+    { sqlthread_proc,           "sqlthread",                      0 },
+    { clock_seconds_proc,       "clock_second",                   0 },
+    { clock_milliseconds_proc,  "clock_milliseconds",             0 },
 #if SQLITE_OS_UNIX && defined(SQLITE_ENABLE_UNLOCK_NOTIFY)
-  Tcl_CreateObjCommand(interp, "sqlite3_blocking_step", blocking_step_proc,0,0);
-  Tcl_CreateObjCommand(interp, 
-      "sqlite3_blocking_prepare_v2", blocking_prepare_v2_proc, (void *)1, 0);
-  Tcl_CreateObjCommand(interp, 
-      "sqlite3_nonblocking_prepare_v2", blocking_prepare_v2_proc, 0, 0);
+    { blocking_step_proc,       "sqlite3_blocking_step",          0 },
+    { blocking_prepare_v2_proc, "sqlite3_blocking_prepare_v2",    1 },
+    { blocking_prepare_v2_proc, "sqlite3_nonblocking_prepare_v2", 0 },
 #endif
+  };
+  int ii;
+
+  for(ii=0; ii<sizeof(aCmd)/sizeof(aCmd[0]); ii++){
+    void *p = SQLITE_INT_TO_PTR(aCmd[ii].iCtx);
+    Tcl_CreateObjCommand(interp, aCmd[ii].zName, aCmd[ii].xProc, p, 0);
+  }
   return TCL_OK;
 }
 #else

diff --git a/test/testrunner.tcl b/test/testrunner.tcl
index c173bfe2b04f35b9b9bca5a1e0e01fae954ba33d..91db8c4df60e4e754ea9b5b820b7066c149f402c 100644 (file)
--- a/test/testrunner.tcl
+++ b/test/testrunner.tcl
@@ -538,7 +538,7 @@ proc script_input_ready {fd iJob b c f} {
       set state "failed" 
     }
 
-    set tm [expr [clock milliseconds] - $T($iJob)]
+    set tm [expr [clock_milliseconds] - $T($iJob)]
 
     puts $R(log) "### $b ### $c ### $f ${tm}ms ($state)"
     puts $R(log) [string trim $O($iJob)]
@@ -582,7 +582,7 @@ proc launch_another_job {iJob} {
   create_or_clear_dir $dir
 
   set O($iJob) ""
-  set T($iJob) [clock milliseconds]
+  set T($iJob) [clock_milliseconds]
   
   set job [r_get_next_job $iJob]
   if {$job==""} return
@@ -624,7 +624,7 @@ proc launch_another_job {iJob} {
 proc one_line_report {} {
   global R
 
-  set tm [expr [clock milliseconds] - $R(starttime)]
+  set tm [expr [clock_milliseconds] - $R(starttime)]
   set tm [format "%.2f" [expr $tm/1000.0]]
 
   foreach s {ready running done failed} {
@@ -657,7 +657,7 @@ proc run_testset {} {
   global R
   set ii 0
 
-  set R(starttime) [clock milliseconds]
+  set R(starttime) [clock_milliseconds]
   set R(log) [open $R(logname) w]
 
   for {set ii 0} {$ii<$R(nJob)} {incr ii} {