SQLite

      /* 0000 */ {0, 0},    /* 0001 */ {4, 1}, 
      /* 0010 */ {3, 1},    /* 0011 */ {3, 2},
      /* 0100 */ {2, 1},    /* 0101 */ {0, 0}, 
      /* 0110 */ {2, 2},    /* 0111 */ {2, 3},
      /* 1000 */ {1, 1},    /* 1001 */ {0, 0}, 
      /* 1010 */ {0, 0},    /* 1011 */ {0, 0},
      /* 1100 */ {1, 2},    /* 1101 */ {0, 0}, 
      /* 1110 */ {0, 0},    /* 1111 */ {0, 0}
    };
    int rc;                       /* Return code of fcntl() */
    struct flock f;               /* Locking operation */

    assert( mRegion<ArraySize(aMap) && aMap[mRegion].iStart!=0 );

    memset(&f, 0, sizeof(f));

# focus of this script is database locks between competing processes.
#
# $Id: lock2.test,v 1.11 2009/05/01 10:55:34 danielk1977 Exp $


set testdir [file dirname $argv0]
source $testdir/tester.tcl
source $testdir/lock_common.tcl































































# Simple locking test case:
#
# lock2-1.1: Connect a second process to the database.
# lock2-1.2: Establish a RESERVED lock with this process.
# lock2-1.3: Get a SHARED lock with the second process.
# lock2-1.4: Try for a RESERVED lock with process 2. This fails.

# 2010 April 14
#
# 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.
#
#***********************************************************************
# This file contains code used by several different test scripts. The
# code in this file allows testfixture to control another process (or
# processes) to test locking.
#

# Launch another testfixture process to be controlled by this one. A
# channel name is returned that may be passed as the first argument to proc
# 'testfixture' to execute a command. The child testfixture process is shut
# down by closing the channel.
proc launch_testfixture {} {
  set prg [info nameofexec]
  if {$prg eq ""} {
    set prg [file join . testfixture]
  }
  set chan [open "|$prg tf_main.tcl" r+]
  fconfigure $chan -buffering line
  return $chan
}

# 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" } { 
      return $r
    }
    if {[eof $chan]} {
      return "ERROR: Child process hung up"
    }
    append r $line
  }
}

# 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
# process, followed by the word "OVER" on a line of its own. The child
# process evaluates the script and writes the results to stdout, followed
# by an "OVER" of its own.
set f [open tf_main.tcl w]
puts $f {
  set l [open log w]
  set script ""
  while {![eof stdin]} {
    flush stdout
    set line [gets stdin]
    puts $l "READ $line"
    if { $line == "OVER" } {
      catch {eval $script} result
      puts $result
      puts $l "WRITE $result"
      puts OVER
      puts $l "WRITE OVER"
      flush stdout
      set script ""
    } else {
      append script $line
      append script " ; "
    }
  }
  close $l
}
close $f

# This file implements regression tests for SQLite library.  The
# focus of this file is testing the operation of the library in
# "PRAGMA journal_mode=WAL" mode.
#

set testdir [file dirname $argv0]
source $testdir/tester.tcl
source $testdir/lock_common.tcl










proc reopen_db {} {
  catch { db close }
  file delete -force test.db test.db-wal
  sqlite3_wal db test.db







}

proc sqlite3_wal {args} {
  eval sqlite3 $args
  [lindex $args 0] eval { PRAGMA journal_mode = wal }
}

} {ok}

foreach handle {db db2 db3} { catch { $handle close } }
unset handle

#-------------------------------------------------------------------------
# The following block of tests - wal-10.* - test that the WAL locking 
# scheme works in simple cases. This block of tests is run twice. Once
# using multiple connections in the address space of the current process,
# and once with all connections except one running in external processes.
#
foreach code [list {
  set ::code2_chan [launch_testfixture]
  set ::code3_chan [launch_testfixture]
  proc code2 {tcl} { testfixture $::code2_chan $tcl }
  proc code3 {tcl} { testfixture $::code3_chan $tcl }
  set tn 1
} {
  proc code2 {tcl} { uplevel #0 $tcl }
  proc code3 {tcl} { uplevel #0 $tcl }
  set tn 2
}] {

  eval $code
  reopen_db

  # Open connections [db2] and [db3]. Depending on which iteration this
  # is, the connections may be created in this interpreter, or in 
  # interpreters running in other OS processes. As such, the [db2] and [db3]
  # commands should only be accessed within [code2] and [code3] blocks,
  # respectively.
  #
  code2 { sqlite3 db2 test.db ; db2 eval { PRAGMA journal_mode = WAL } }
  code3 { sqlite3 db3 test.db ; db3 eval { PRAGMA journal_mode = WAL } }

  # Shorthand commands. Execute SQL using database connection [db2] or 
  # [db3]. Return the results.
  #
  proc sql2 {sql} { code2 [list db2 eval $sql] }
  proc sql3 {sql} { code3 [list db3 eval $sql] }

  # Initialize the database schema and contents.
  #
  do_test wal-10.$tn.1 {
    execsql {
      CREATE TABLE t1(a, b);
      INSERT INTO t1 VALUES(1, 2);
      SELECT * FROM t1;
    }
  } {1 2}

  # Open a transaction and write to the database using [db]. Check that [db2]
  # is still able to read the snapshot before the transaction was opened.
  #
  do_test wal-10.$tn.2 {
    execsql { BEGIN; INSERT INTO t1 VALUES(3, 4); }
    sql2 {SELECT * FROM t1}
  } {1 2}

  # Have [db] commit the transaction. Check that [db2] is now seeing the 
  # new, updated snapshot.
  #
  do_test wal-10.$tn.3 {
    execsql { COMMIT }
    sql2 {SELECT * FROM t1}
  } {1 2 3 4}

  # Have [db2] open a read transaction. Then write to the db via [db]. Check
  # that [db2] is still seeing the original snapshot. Then read with [db3].
  # [db3] should see the newly committed data.
  #
  do_test wal-10.$tn.4 {
    sql2 { BEGIN ; SELECT * FROM t1}
  } {1 2 3 4}
  do_test wal-10.$tn.5 {
    execsql { INSERT INTO t1 VALUES(5, 6); }
    sql2 {SELECT * FROM t1}
  } {1 2 3 4}
  do_test wal-10.$tn.6 {
    sql3 {SELECT * FROM t1}
  } {1 2 3 4 5 6}
  do_test wal-10.$tn.7 {
    sql2 COMMIT
  } {}

  # Have [db2] open a write transaction. Then attempt to write to the 
  # database via [db]. This should fail (writer lock cannot be obtained).
  #
  # Then open a read-transaction with [db]. Commit the [db2] transaction
  # to disk. Verify that [db] still cannot write to the database (because
  # it is reading an old snapshot).
  #
  # Close the current [db] transaction. Open a new one. [db] can now write
  # to the database (as it is not locked and [db] is reading the latest
  # snapshot).
  #
  do_test wal-10.$tn.7 {
    sql2 { BEGIN; INSERT INTO t1 VALUES(7, 8) ; }
    catchsql { INSERT INTO t1 VALUES(9, 10) }
  } {1 {database is locked}}
  do_test wal-10.$tn.8 {
    execsql { BEGIN ; SELECT * FROM t1 }
  } {1 2 3 4 5 6}
  do_test wal-10.$tn.9 {
    sql2 COMMIT
    catchsql { INSERT INTO t1 VALUES(9, 10) }
  } {1 {database is locked}}
  do_test wal-10.$tn.10 {
    execsql { COMMIT; BEGIN; INSERT INTO t1 VALUES(9, 10); COMMIT; }
    execsql { SELECT * FROM t1 }
  } {1 2 3 4 5 6 7 8 9 10}

  # Open a read transaction with [db2]. Check that this prevents [db] from
  # checkpointing the database. But not from writing to it.
  #
  do_test wal-10.$tn.11 {
    sql2 { BEGIN; SELECT * FROM t1 }
  } {1 2 3 4 5 6 7 8 9 10}
  do_test wal-10.$tn.12 {
    catchsql { PRAGMA checkpoint } 
  } {1 {database is locked}}
  do_test wal-10.$tn.13 {
    execsql { INSERT INTO t1 VALUES(11, 12) }
    sql2 {SELECT * FROM t1}
  } {1 2 3 4 5 6 7 8 9 10}

  # Connection [db2] is holding a lock on a snapshot, preventing [db] from
  # checkpointing the database. Add a busy-handler to [db]. If [db2] completes
  # its transaction from within the busy-handler, [db] is able to complete
  # the checkpoint operation.
  #
  proc busyhandler x {
    if {$x==4} { sql2 COMMIT }


    if {$x<5} { return 0 }
    return 1
  }
  db busy busyhandler
  do_test wal-10.$tn.14 {
    execsql { PRAGMA checkpoint } 
  } {}

  # Similar to the test above. Except this time, a new read transaction is
  # started (db3) while the checkpointer is waiting for an old one (db2) to 
  # finish. The checkpointer can finish, but any subsequent write operations 
  # must wait until after db3 has closed the read transaction, as db3 is a
  # "region D" writer.
  #
  db busy {}
  do_test wal-10.$tn.15 {


    sql2 { BEGIN; SELECT * FROM t1; }

  } {1 2 3 4 5 6 7 8 9 10 11 12}
  do_test wal-10.$tn.16 {

    catchsql { PRAGMA checkpoint } 
  } {1 {database is locked}}
  proc busyhandler x {
    if {$x==3} { sql3 { BEGIN; SELECT * FROM t1 } }
    if {$x==4} { sql2 COMMIT }
    if {$x<5}  { return 0 }
    return 1
  }
  db busy busyhandler
  do_test wal-10.$tn.9 {
    execsql { PRAGMA checkpoint } 
  } {}
  do_test wal-10.$tn.10 {
    sql3 { SELECT * FROM t1 }
  } {1 2 3 4 5 6 7 8 9 10 11 12}
  do_test wal-10.$tn.11 {
    catchsql { INSERT INTO t1 VALUES(13, 14) }
  } {1 {database is locked}}
  do_test wal-10.$tn.12 {
    execsql { SELECT * FROM t1 }
  } {1 2 3 4 5 6 7 8 9 10 11 12}
  do_test wal-10.$tn.13 {
    sql3 COMMIT
  } {}
  do_test wal-10.$tn.14 {
    execsql { INSERT INTO t1 VALUES(13, 14) }
    execsql { SELECT * FROM t1 }
  } {1 2 3 4 5 6 7 8 9 10 11 12 13 14}

  catch { db close }
  catch { code2 { db2 close } }
  catch { code3 { db3 close } }
  catch { close $::code2_chan }
  catch { close $::code3_chan }
}

finish_test