Change walthread.test so that tests can be run with either multiple threads or multiple processes.

FossilOrigin-Name: 25f85f68723e56c18e44b094d85f67b99912dc86

manifest

@@ -1,5 +1,5 @@
-C Merge\stwo\s"wal"\sleaves.
+C Change\swalthread.test\sso\sthat\stests\scan\sbe\srun\swith\seither\smultiple\sthreads\sor\smultiple\sprocesses.
-D 2010-04-27T18:49:54
+D 2010-04-28T17:48:44
 F Makefile.arm-wince-mingw32ce-gcc fcd5e9cd67fe88836360bb4f9ef4cb7f8e2fb5a0
 F Makefile.in d83a0ffef3dcbfb08b410a6c6dd6c009ec9167fb
 F Makefile.linux-gcc d53183f4aa6a9192d249731c90dbdffbd2c68654
@@ -204,7 +204,7 @@ F src/test_pcache.c 7bf828972ac0d2403f5cfa4cd14da41f8ebe73d8
 F src/test_schema.c 8c06ef9ddb240c7a0fcd31bc221a6a2aade58bf0
 F src/test_server.c bbba05c144b5fc4b52ff650a4328027b3fa5fcc6
 F src/test_tclvar.c f4dc67d5f780707210d6bb0eb6016a431c04c7fa
-F src/test_thread.c 00fed80690ae7f1525483a35861511c48bc579f2
+F src/test_thread.c aa9919c885a1fe53eafc73492f0898ee6c0a0726
 F src/test_wsd.c 41cadfd9d97fe8e3e4e44f61a4a8ccd6f7ca8fe9
 F src/tokenize.c 25ceb0f0a746ea1d0f9553787f3f0a56853cfaeb
 F src/trigger.c 8927588cb9e6d47f933b53bfe74200fbb504100d
@@ -221,7 +221,7 @@ F src/vdbeblob.c 5327132a42a91e8b7acfb60b9d2c3b1c5c863e0e
 F src/vdbemem.c 2a82f455f6ca6f78b59fb312f96054c04ae0ead1
 F src/vdbetrace.c 864cef96919323482ebd9986f2132435115e9cc2
 F src/vtab.c a0f8a40274e4261696ef57aa806de2776ab72cda
-F src/wal.c 1576b36d55220d42598a5fb48a06e083efecea75
+F src/wal.c d63318e8e73f9ed1a6f3c277f71022024f38a7c3
 F src/wal.h 812101dd76610401fbcd44114e7e8b7ce0224645
 F src/walker.c 3112bb3afe1d85dc52317cb1d752055e9a781f8f
 F src/where.c faadd9c2bf08868e5135192b44e0d753e363a885
@@ -479,7 +479,7 @@ F test/lock4.test f4f36271aa5ae1da449646bf43c7341f6b2b4c4e
 F test/lock5.test 6b1f78f09ad1522843dad571b76b321e6f439bf7
 F test/lock6.test 862aa71e97b288d6b3f92ba3313f51bd0b003776
 F test/lock7.test 64006c84c1c616657e237c7ad6532b765611cf64
-F test/lock_common.tcl ebc5b9a238d6d9f08a8433e52bdbc67d1478e774
+F test/lock_common.tcl bbc4e15ee5334cc4d01fcac08d7c9de7d8906e55
 F test/lookaside.test 1dd350dc6dff015c47c07fcc5a727a72fc5bae02
 F test/main.test 2be2352ac77ac5b238c6337a5469aeeef57677e6
 F test/make-where7.tcl 05c16b5d4f5d6512881dfec560cb793915932ef9
@@ -764,7 +764,7 @@ F test/walcrash.test f022cee7eb7baa5fb898726120a6a4073dd831d1
 F test/walhook.test 76a559e262f0715c470bade4a8d8333035f8ee47
 F test/walmode.test 40119078da084e6a7403ba57485d5a86ee0e2646
 F test/walslow.test 38076d5fad49e3678027be0f8110e6a32d531dc2
-F test/walthread.test a7962d8b899366cc71f8381d9aeab8ae9e1b544d
+F test/walthread.test 871aeecc5b89133b094bcc00c4fcfa040749c726
 F test/where.test de337a3fe0a459ec7c93db16a519657a90552330
 F test/where2.test 45eacc126aabb37959a387aa83e59ce1f1f03820
 F test/where3.test aa44a9b29e8c9f3d7bb94a3bb3a95b31627d520d
@@ -808,7 +808,7 @@ F tool/speedtest2.tcl ee2149167303ba8e95af97873c575c3e0fab58ff
 F tool/speedtest8.c 2902c46588c40b55661e471d7a86e4dd71a18224
 F tool/speedtest8inst1.c 293327bc76823f473684d589a8160bde1f52c14e
 F tool/vdbe-compress.tcl d70ea6d8a19e3571d7ab8c9b75cba86d1173ff0f
-P be44349d2b790fb470fcc9fb6a12e8b1076dc645 ed715b47c5f7657fbf901805981867898054b14d
+P 8c2d43babd61fe2225d5c402174253f412604092
-R 543123f4859d04253152521c95f2472b
+R 797336faa9830e538744894acb6ac97d
 U dan
-Z 67c1d58e24d1fcb9816b2a39774cf9f7
+Z 5512df46d9c359853729f7512b676a72

manifest.uuid

@@ -1 +1 @@
-8c2d43babd61fe2225d5c402174253f412604092
+25f85f68723e56c18e44b094d85f67b99912dc86

src/test_thread.c

@@ -58,6 +58,7 @@ static Tcl_ObjCmdProc blocking_step_proc;
 static Tcl_ObjCmdProc blocking_prepare_v2_proc;
 #endif
 int Sqlitetest1_Init(Tcl_Interp *);
+int Sqlite3_Init(Tcl_Interp *);
 
 /* Functions from test1.c */
 void *sqlite3TestTextToPtr(const char *);
@@ -124,6 +125,7 @@ static Tcl_ThreadCreateType tclScriptThread(ClientData pSqlThread){
 #endif
   Sqlitetest1_Init(interp);
   Sqlitetest_mutex_Init(interp);
+  Sqlite3_Init(interp);
 
   rc = Tcl_Eval(interp, p->zScript);
   pRes = Tcl_GetObjResult(interp);

test/lock_common.tcl

@@ -46,6 +46,27 @@ proc testfixture {chan cmd} {
   }
 }
 
+proc testfixture_nb_cb {varname chan} {
+  set line [gets $chan]
+  if { $line == "OVER" } {
+    set $varname $::tfnb($chan)
+    unset ::tfnb($chan)
+    close $chan
+  } else {
+    append ::tfnb($chan) $line
+  }
+}
+
+proc testfixture_nb {varname cmd} {
+  set chan [launch_testfixture]
+  set ::tfnb($chan) ""
+  fconfigure $chan -blocking 0 -buffering none
+  puts $chan $cmd
+  puts $chan OVER
+  fileevent $chan readable [list testfixture_nb_cb $varname $chan]
+  return ""
+}
+
 # Write the main loop for the child testfixture processes into file
 # tf_main.tcl. The parent (this script) interacts with the child processes
 # via a two way pipe. The parent writes a script to the stdin of the child
@@ -61,7 +82,7 @@ puts $f {
     set line [gets stdin]
     puts $l "READ $line"
     if { $line == "OVER" } {
-      catch {eval $script} result
+      set rc [catch {eval $script} result]
       puts $result
       puts $l "WRITE $result"
       puts OVER
@@ -70,7 +91,7 @@ puts $f {
       set script ""
     } else {
       append script $line
-      append script " ; "
+      append script "\n"
     }
   }
   close $l

test/walthread.test

@@ -16,43 +16,158 @@
 set testdir [file dirname $argv0]
 
 source $testdir/tester.tcl
+source $testdir/lock_common.tcl
 if {[run_thread_tests]==0} { finish_test ; return }
 
 set sqlite_walsummary_mmap_incr 64
 
-#--------------------------------------------------------------------------
+# The number of threads to start. And the amount of time to run the test
-# Initialize the database used for the multi-thread test.
+# for. Respectively.
 #
-do_test walthread-1.1 {
+set NTHREAD 10
-  execsql {
+set SECONDS 5
-    PRAGMA journal_mode = WAL;
+
-    PRAGMA lock_status;
+# The parameter is the name of a variable in the callers context. The
-    CREATE TABLE t1(x PRIMARY KEY);
+# variable may or may not exist when this command is invoked.
-    PRAGMA lock_status;
+#
-    INSERT INTO t1 VALUES(randomblob(100));
+# If the variable does exist, its value is returned. Otherwise, this
-    INSERT INTO t1 VALUES(randomblob(100));
+# command uses [vwait] to wait until it is set, then returns the value.
-    INSERT INTO t1 SELECT md5sum(x) FROM t1;
+# In other words, this is a version of the [set VARNAME] command that
+# blocks until a variable exists.
+#
+proc wait_for_var {varname} {
+  if {0==[uplevel [list info exists $varname]]} {
+    uplevel [list vwait $varname]
   }
-} {wal main unlocked temp closed main shared temp closed}
+  uplevel [list set $varname]
-do_test walthread-1.2 {
+}
-  execsql {
+
-    SELECT (SELECT count(*) FROM t1), (
+proc lshift {lvar} {
-      SELECT md5sum(x) FROM t1 WHERE oid != (SELECT max(oid) FROM t1)
+  upvar $lvar L
-    ) == (
+  set ret [lindex $L 0]
-      SELECT x FROM t1 WHERE oid = (SELECT max(oid) FROM t1)
+  set L [lrange $L 1 end]
-    )
+  return $ret
+}
+
+
+#-------------------------------------------------------------------------
+#   do_thread_test TESTNAME OPTIONS...
+# 
+# where OPTIONS are: 
+#
+#   -seconds   SECONDS                How many seconds to run the test for
+#   -init      SCRIPT                 Script to run before test.
+#   -thread    NAME COUNT SCRIPT      Scripts to run in threads (or processes).
+#   -processes BOOLEAN                True to use processes instead of threads.
+#
+proc do_thread_test {args} {
+  set A $args
+
+  set P(testname) [lshift A]
+  set P(seconds) 5
+  set P(init) ""
+  set P(threads) [list]
+  set P(processes) 0
+
+  unset -nocomplain ::done
+
+  while {[llength $A]>0} {
+    set a [lshift A]
+    switch -glob -- $a {
+      -seconds {
+        set P(seconds) [lshift A]
       }
-} {3 1}
+
-do_test walthread-1.3 {
+      -init {
-  execsql { PRAGMA integrity_check } 
+        set P(init) [lshift A]
-} {ok}
+      }
-do_test walthread-1.4 {
+
-  execsql { PRAGMA lock_status } 
+      -processes {
-} {main shared temp unknown}
+        set P(processes) [lshift A]
+      }
+
+      -thread {
+        set name  [lshift A]
+        set count [lshift A]
+        set prg   [lshift A]
+        lappend P(threads) [list $name $count $prg]
+      }
+
+      default {
+        error "Unknown option: $a"
+      }
+    }
+  }
+
+  puts "Running $P(testname) for $P(seconds) seconds..."
+
+  catch { db close }
+  file delete -force test.db test.db-journal test.db-wal
+
+  sqlite3 db test.db
+  eval $P(init)
+  db close
+
+  foreach T $P(threads) {
+    set name  [lindex $T 0]
+    set count [lindex $T 1]
+    set prg   [lindex $T 2]
+
+    for {set i 1} {$i <= $count} {incr i} {
+      set program [string map [list %TEST% $prg %SECONDS% $P(seconds) %I% $i] {
+
+        set tid %I%
+
+        proc usleep {ms} {
+          set ::usleep 0
+          after $ms {set ::usleep 1}
+          vwait ::usleep
+        }
+        proc busyhandler {n} { usleep 10 ; return 0 }
+
+        sqlite3 db test.db
+        db busy busyhandler
+        db eval { SELECT randomblob($tid*5) }
+
+        set ::finished 0
+        after [expr %SECONDS% * 1000] {set ::finished 1}
+        proc tt_continue {} { expr ($::finished==0) }
+
+        set rc [catch { %TEST% } msg]
+
+        db close
+        list $rc $msg
+      }]
+
+      if {$P(processes)==0} {
+        sqlthread spawn ::done($name,$i) $program
+      } else {
+        testfixture_nb ::done($name,$i) $program
+      }
+    }
+  }
+
+  set report "  Results:"
+  foreach T $P(threads) {
+    set name  [lindex $T 0]
+    set count [lindex $T 1]
+    set prg   [lindex $T 2]
+
+    set reslist [list]
+    for {set i 1} {$i <= $count} {incr i} {
+      set res [wait_for_var ::done($name,$i)]
+      lappend reslist [lindex $res 1]
+      do_test $P(testname).$name.$i [list lindex $res 0] 0
+    }
+
+    append report "   $name $reslist"
+  }
+  puts $report
+}
 
 #--------------------------------------------------------------------------
-# Start N threads. Each thread performs both read and write transactions.
+# Start NTHREAD threads. Each thread performs both read and write 
-# Each read transaction consists of:
+# transactions. Each read transaction consists of:
 #
 #   1) Reading the md5sum of all but the last table row,
 #   2) Running integrity check.
@@ -71,132 +186,73 @@ do_test walthread-1.4 {
 #
 # Ther is also a single checkpointer thread. It runs the following loop:
 #
-#   1) Execute "CHECKPOINT main 32 -1 1"
+#   1) Execute "PRAGMA checkpoint"
 #   2) Sleep for 500 ms.
 #
-set thread_program {
-  proc rest {ms} {
-    set ::rest 0
-    after $ms {set ::rest 1}
-    vwait ::rest
-  }
 
-  proc dosql {DB sql} {
+foreach {mode name} {
-    set res ""
+      0 walthread-1-threads 
-    set stmt [sqlite3_prepare_v2 $DB $sql -1 dummy_tail]
+      1 walthread-1-processes
-    set rc [sqlite3_step $stmt]
+} {
-    if {$rc eq "SQLITE_ROW"} {
+  do_thread_test $name -processes $mode -seconds $SECONDS -init {
-      set res [sqlite3_column_text $stmt 0]
+    execsql {
+      PRAGMA journal_mode = WAL;
+      CREATE TABLE t1(x PRIMARY KEY);
+      PRAGMA lock_status;
+      INSERT INTO t1 VALUES(randomblob(100));
+      INSERT INTO t1 VALUES(randomblob(100));
+      INSERT INTO t1 SELECT md5sum(x) FROM t1;
     }
-    set rc [sqlite3_finalize $stmt]
+  } -thread main $NTHREAD {
   
-    if {$rc ne "SQLITE_OK"} {
+    proc read_transaction {} {
-      error "$rc: [sqlite3_errmsg $DB]"
+      set results [db eval {
-    }
+        BEGIN;
-    return $res
+          PRAGMA integrity_check;
-  }
+          SELECT md5sum(x) FROM t1 WHERE rowid != (SELECT max(rowid) FROM t1);
-
+          SELECT x FROM t1 WHERE rowid = (SELECT max(rowid) FROM t1);
-  proc read_transaction {DB} {
+          SELECT md5sum(x) FROM t1 WHERE rowid != (SELECT max(rowid) FROM t1);
-    dosql $DB BEGIN
+        COMMIT;
-
-    set md5_1 [dosql $DB {
-      SELECT md5sum(x) FROM t1 WHERE rowid != (SELECT max(rowid) FROM t1)
-    }]
-    set check [dosql $DB { PRAGMA integrity_check }]
-    set md5_2 [dosql $DB { 
-      SELECT x FROM t1 WHERE rowid = (SELECT max(rowid) FROM t1)
-    }]
-    set md5_3 [dosql $DB {
-      SELECT md5sum(x) FROM t1 WHERE rowid != (SELECT max(rowid) FROM t1)
       }]
   
-    dosql $DB COMMIT
+      if {[llength $results]!=4
-
+       || [lindex $results 0] != "ok"
-    if {$check ne "ok" 
+       || [lindex $results 1] != [lindex $results 2]
-     || $md5_1 ne $md5_2
+       || [lindex $results 2] != [lindex $results 3]
-     || $md5_2 ne $md5_3
       } {
-      error "Failed read transaction $check $md5_1 $md5_2 $md5_3"
+        error "Failed read transaction: $results"
       }
     }
   
-  proc write_transaction {DB} {
+    proc write_transaction {} {
-    dosql $DB BEGIN
+      db eval {
-    dosql $DB "INSERT INTO t1 VALUES(randomblob(100))"
+        BEGIN;
-    dosql $DB "INSERT INTO t1 VALUES(randomblob(100))"
+          INSERT INTO t1 VALUES(randomblob(100));
-    dosql $DB "INSERT INTO t1 SELECT md5sum(x) FROM t1"
+          INSERT INTO t1 VALUES(randomblob(100));
-    dosql $DB COMMIT
+          INSERT INTO t1 SELECT md5sum(x) FROM t1;
-  }
+        COMMIT;
-
-  proc checkpointer {DB} {
-    while { !$::finished } {
-      dosql $DB "PRAGMA checkpoint"
-      rest 1000
       }
     }
   
-  proc worker {DB N} {
+    set nRun 0
-    set j 0
+    while {[tt_continue]} {
-    while { !$::finished } {
+      read_transaction
-      for {set i 0} {$i < $N} {incr i} { read_transaction $DB }
+      write_transaction 
-      write_transaction $DB
+      usleep 1
-      rest 1
+      incr nRun
     }
+    set nRun
+  
+  } -thread ckpt 1 {
+    set nRun 0
+    while {[tt_continue]} {
+      db eval "PRAGMA checkpoint"
+      usleep 500
+      incr nRun
+    }
+    set nRun
   }
-
-  set ::finished 0
-  after [expr $seconds*1000] {set ::finished 1}
-
-  set ::DB [sqlthread open test.db]
-  dosql $::DB { PRAGMA journal_mode = WAL }
-
-
-  set rc [catch {
-    if {$role eq "worker"} { worker $DB $N }
-    if {$role eq "checkpointer"} { checkpointer $DB }
-  } msg]
-
-  sqlite3_close $::DB
-
-  if {$rc==0} { set msg OK } 
-  set msg
 }
 
-set NTHREAD 6
-set SECONDS 30
-
-#set prg "set N $NTHREAD ; set seconds $SECONDS"
-set prg "set N 1 ; set seconds $SECONDS"
-
-array unset finished
-for {set i 0} {$i < $NTHREAD} {incr i} {
-  thread_spawn finished($i) {set role worker} $prg $thread_program
-}
-thread_spawn finished(C) {set role checkpointer} $prg $thread_program
-#set finished(C) 1
-
-puts "... test runs for approximately $SECONDS seconds ..."
-for {set i 0} {$i < $::NTHREAD} {incr i} {
-  if {![info exists finished($i)]} {
-    vwait finished($i)
-  }
-  do_test walthread-2.$i {
-    set ::finished($i)
-  } OK
-}
-do_test walthread-2.C {
-  if {![info exists finished(C)]} { vwait finished(C) }
-  set ::finished(C)
-} OK
-
-set logsize 0
-
-set rows    [execsql { SELECT count(*) FROM t1 }]
-catch { set logsize [expr [file size test.db-wal] / 1024] }
-set dbsize  [expr [file size test.db] / 1024]
-
-puts "rows=$rows db=${dbsize}K log=${logsize}K"
-
 finish_test
 
-