Add a test for the change on this branch.

FossilOrigin-Name: e22dde187eb0b389d6d93e2e39a26fd0f4e6196e

5 files changed, 177 insertions, 33 deletions

diff --git a/manifest b/manifest
index 881ae7d64..d62ee302a 100644
--- a/manifest
+++ b/manifest
@@ -1,5 +1,5 @@
-C Arrange\sfor\ssome\sof\sthe\stransient\slocks\sin\sWAL\smode\sto\sblock,\sas\sa\ssingle\nto\sthe\sOS\sto\sfix\spriority\sinversions.
-D 2015-03-10T20:22:35.302
+C Add\sa\stest\sfor\sthe\schange\son\sthis\sbranch.
+D 2015-03-17T16:01:29.508
 F Makefile.arm-wince-mingw32ce-gcc d6df77f1f48d690bd73162294bbba7f59507c72f
 F Makefile.in 2f643d6968dfc0b82d2e546a0525a39079f9e928
 F Makefile.linux-gcc 91d710bdc4998cb015f39edf3cb314ec4f4d7e23
@@ -283,7 +283,7 @@ F src/test_superlock.c 06797157176eb7085027d9dd278c0d7a105e3ec9
 F src/test_syscall.c 2e21ca7f7dc54a028f1967b63f1e76155c356f9b
 F src/test_tclvar.c f4dc67d5f780707210d6bb0eb6016a431c04c7fa
 F src/test_thread.c af391ec03d23486dffbcc250b7e58e073f172af9
-F src/test_vfs.c 5a14c63da9579ba148138c1fb233100f2eb58ebb
+F src/test_vfs.c b7e6831e6fcf04c5090accff30640ec5c9630739
 F src/test_vfstrace.c bab9594adc976cbe696ff3970728830b4c5ed698
 F src/test_wsd.c 41cadfd9d97fe8e3e4e44f61a4a8ccd6f7ca8fe9
 F src/threads.c 6bbcc9fe50c917864d48287b4792d46d6e873481
@@ -702,7 +702,7 @@ F test/lock4.test e175ae13865bc87680607563bafba21f31a26f12
 F test/lock5.test c6c5e0ebcb21c61a572870cc86c0cb9f14cede38
 F test/lock6.test ad5b387a3a8096afd3c68a55b9535056431b0cf5
 F test/lock7.test 49f1eaff1cdc491cc5dee3669f3c671d9f172431
-F test/lock_common.tcl 0c270b121d40959fa2f3add382200c27045b3d95
+F test/lock_common.tcl 7ffb45accf6ee91c736df9bafe0806a44358f035
 F test/lookaside.test 93f07bac140c5bb1d49f3892d2684decafdc7af2
 F test/main.test 16131264ea0c2b93b95201f0c92958e85f2ba11a
 F test/make-where7.tcl 05c16b5d4f5d6512881dfec560cb793915932ef9
@@ -1139,6 +1139,7 @@ F test/wal9.test 378e76a9ad09cd9bee06c172ad3547b0129a6750
 F test/wal_common.tcl a98f17fba96206122eff624db0ab13ec377be4fe
 F test/walbak.test b9f68e39646375c2b877be906babcc15d38b4877
 F test/walbig.test f437473a16cfb314867c6b5d1dbcd519e73e3434
+F test/walblock.test f1290524714232c109fb0b14db28f14d81c3ddd0
 F test/walcksum.test 9afeb96240296c08c72fc524d199c912cfe34daa
 F test/walcrash.test 451d79e528add5c42764cea74aa2750754171b25
 F test/walcrash2.test a0edab4e5390f03b99a790de89aad15d6ec70b36
@@ -1241,10 +1242,7 @@ F tool/vdbe_profile.tcl 67746953071a9f8f2f668b73fe899074e2c6d8c1
 F tool/warnings-clang.sh f6aa929dc20ef1f856af04a730772f59283631d4
 F tool/warnings.sh 0abfd78ceb09b7f7c27c688c8e3fe93268a13b32
 F tool/win/sqlite.vsix deb315d026cc8400325c5863eef847784a219a2f
-P 8d0b11c96e15556dd65ced05708a832aef134e69
-R e3a6235cb886b3e146e5aa9fea4e9436
-T *branch * wal-blocking-lock
-T *sym-wal-blocking-lock *
-T -sym-trunk *
-U drh
-Z 53b7d268fee9eb6c03e124e757f212c1
+P c6e6d5f4e06c3ac0bfb620c0c728fbc7230c4a02
+R 15a95b25b03827505e198326f8e27a62
+U dan
+Z 12b0ab91b3a13b6777d198c7ff155c7d
diff --git a/manifest.uuid b/manifest.uuid
index e908b35f9..21c37ab89 100644
--- a/manifest.uuid
+++ b/manifest.uuid
@@ -1 +1 @@
-c6e6d5f4e06c3ac0bfb620c0c728fbc7230c4a02
\ No newline at end of file
+e22dde187eb0b389d6d93e2e39a26fd0f4e6196e
\ No newline at end of file
diff --git a/src/test_vfs.c b/src/test_vfs.c
index 561addfcc..2277cf7eb 100644
--- a/src/test_vfs.c
+++ b/src/test_vfs.c
@@ -967,16 +967,15 @@ static void tvfsShmBarrier(sqlite3_file *pFile){
   TestvfsFd *pFd = tvfsGetFd(pFile);
   Testvfs *p = (Testvfs *)(pFd->pVfs->pAppData);
 
+  if( p->pScript && p->mask&TESTVFS_SHMBARRIER_MASK ){
+    const char *z = pFd->pShm ? pFd->pShm->zFile : "";
+    tvfsExecTcl(p, "xShmBarrier", Tcl_NewStringObj(z, -1), pFd->pShmId, 0, 0);
+  }
+
   if( p->isFullshm ){
     sqlite3OsShmBarrier(pFd->pReal);
     return;
   }
-
-  if( p->pScript && p->mask&TESTVFS_SHMBARRIER_MASK ){
-    tvfsExecTcl(p, "xShmBarrier", 
-        Tcl_NewStringObj(pFd->pShm->zFile, -1), pFd->pShmId, 0, 0
-    );
-  }
 }
 
 static int tvfsShmUnmap(
@@ -1532,7 +1531,7 @@ static int testvfs_cmd(
   return TCL_OK;
 
  bad_args:
-  Tcl_WrongNumArgs(interp, 1, objv, "VFSNAME ?-noshm BOOL? ?-default BOOL? ?-mxpathname INT? ?-szosfile INT? ?-iversion INT?");
+  Tcl_WrongNumArgs(interp, 1, objv, "VFSNAME ?-noshm BOOL? ?-fullshm BOOL? ?-default BOOL? ?-mxpathname INT? ?-szosfile INT? ?-iversion INT?");
   return TCL_ERROR;
 }
 
diff --git a/test/lock_common.tcl b/test/lock_common.tcl
index bc1eb86bd..a758e7af2 100644
--- a/test/lock_common.tcl
+++ b/test/lock_common.tcl
@@ -86,21 +86,51 @@ proc launch_testfixture {{prg ""}} {
 # Execute a command in a child testfixture process, connected by two-way
 # channel $chan. Return the result of the command, or an error message.
 #
-proc testfixture {chan cmd} {
-  puts $chan $cmd
-  puts $chan OVER
-  set r ""
-  while { 1 } {
-    set line [gets $chan]
-    if { $line == "OVER" } { 
-      set res [lindex $r 1]
-      if { [lindex $r 0] } { error $res }
-      return $res
-    }
-    if {[eof $chan]} {
-      return "ERROR: Child process hung up"
+proc testfixture {chan cmd args} {
+
+  if {[llength $args] == 0} {
+    fconfigure $chan -blocking 1
+    puts $chan $cmd
+    puts $chan OVER
+
+    set r ""
+    while { 1 } {
+      set line [gets $chan]
+      if { $line == "OVER" } { 
+        set res [lindex $r 1]
+        if { [lindex $r 0] } { error $res }
+        return $res
+      }
+      if {[eof $chan]} {
+        return "ERROR: Child process hung up"
+      }
+      append r $line
     }
-    append r $line
+    return $r
+  } else {
+    set ::tfnb($chan) ""
+    fconfigure $chan -blocking 0 -buffering none
+    puts $chan $cmd
+    puts $chan OVER
+    fileevent $chan readable [list testfixture_script_cb $chan [lindex $args 0]]
+    return ""
+  }
+}
+
+proc testfixture_script_cb {chan script} {
+  if {[eof $chan]} {
+    append ::tfnb($chan) "ERROR: Child process hung up"
+    set line "OVER"
+  } else {
+    set line [gets $chan]
+  }
+
+  if { $line == "OVER" } {
+    uplevel #0 $script [list [lindex $::tfnb($chan) 1]]
+    unset ::tfnb($chan)
+    fileevent $chan readable ""
+  } else {
+    append ::tfnb($chan) $line
   }
 }
 
diff --git a/test/walblock.test b/test/walblock.test
new file mode 100644
index 000000000..9a85ea4ac
--- /dev/null
+++ b/test/walblock.test
@@ -0,0 +1,117 @@
+# 2015 Mar 17
+#
+# The author disclaims copyright to this source code.  In place of
+# a legal notice, here is a blessing:
+#
+#    May you do good and not evil.
+#    May you find forgiveness for yourself and forgive others.
+#    May you share freely, never taking more than you give.
+#
+#***********************************************************************
+#
+
+set testdir [file dirname $argv0]
+source $testdir/tester.tcl
+source $testdir/lock_common.tcl
+source $testdir/wal_common.tcl
+
+ifcapable !wal {finish_test ; return }
+if {$::tcl_platform(platform)!="unix"} { finish_test ; return }
+set testprefix walblock
+
+catch { db close }
+testvfs tvfs -fullshm 1
+foreach f [glob test.db*] { forcedelete $f }
+
+sqlite3 db test.db -vfs tvfs
+do_execsql_test 1.1.0 {
+  CREATE TABLE t1(x, y);
+  INSERT INTO t1 VALUES(1, 2);
+  INSERT INTO t1 VALUES(3, 4);
+  INSERT INTO t1 VALUES(5, 6);
+  PRAGMA journal_mode = wal;
+  INSERT INTO t1 VALUES(7, 8);
+} {wal}
+
+do_test 1.1.1 { 
+  lsort [glob test.db*] 
+} {test.db test.db-shm test.db-wal}
+
+do_test 1.1.2 { 
+  set C [launch_testfixture]
+  testfixture $C {
+    sqlite3 db test.db
+    db eval { SELECT * FROM t1 }
+  }
+} {1 2 3 4 5 6 7 8}
+
+do_test 1.1.3 { 
+  set ::out [list]
+  testfixture $C {
+    db eval { SELECT * FROM t1 }
+  } [list set ::out]
+  set ::out
+} {}
+
+do_test 1.1.4 { 
+  vwait ::out
+  set ::out
+} {1 2 3 4 5 6 7 8}
+
+#
+# Test that if a read client cannot read the wal-index header because a
+# write client is in the middle of updating it, the reader blocks until
+# the writer finishes.
+#
+#   1. Open a write transaction using client [db] in this process.
+#
+#   2. Attempt to commit the write transaction. Intercept the xShmBarrier()
+#      call made by the writer between updating the two copies of the
+#      wal-index header.
+#
+#   3. Within the xShmBarrier() callback, make an asynchronous request to
+#      the other process to read from the database. It should block, as it
+#      cannot get read the wal-index header.
+#
+#   4. Still in xShmBarrier(), wait for 5 seconds. Check that the other
+#      process has not answered the request.
+#
+#   5: Finish committing the transaction. Then wait for 0.5 seconds more.
+#      Ensure that the second process has by this stage read the database
+#      and that the snapshot it read included the transaction committed in
+#      step (4).
+#
+do_execsql_test 1.2.1 {
+  BEGIN;
+    INSERT INTO t1 VALUES(9, 10);
+} {}
+
+tvfs script barrier_callback
+tvfs filter xShmBarrier
+proc barrier_callback {method args} {
+  set ::out ""
+  testfixture $::C { db eval { SELECT * FROM t1 } } {set ::out}
+
+  do_test "1.2.2.(blocking 5 seconds)" { 
+    set ::continue 0
+    after 5000 {set ::continue 1}
+    vwait ::continue
+    set ::out 
+  } {}
+}
+
+execsql COMMIT
+
+do_test "1.2.3.(blocking 0.5 seconds)" { 
+  set ::continue 0
+  after 500 {set ::continue 1}
+  vwait ::continue
+  set ::out 
+} {1 2 3 4 5 6 7 8 9 10}
+
+
+finish_test
+
+
+
+