SQLite

  fconfigure $chan -buffering line
  testfixture $chan "sqlite3_test_control_pending_byte $::sqlite_pending_byte"
  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" } { 
      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
  }
}

proc testfixture_nb_cb {varname chan} {
  if {[eof $chan]} {
    append ::tfnb($chan) "ERROR: Child process hung up"
    set line "OVER"
  } else {
    set line [gets $chan]
  }

  if { $line == "OVER" } {
    set $varname [lindex $::tfnb($chan) 1]
    unset ::tfnb($chan)
    close $chan
  } else {
    append ::tfnb($chan) $line
  }
}

  set script ""
  while {![eof stdin]} {
    flush stdout
    set line [gets stdin]
    puts $l "READ $line"
    if { $line == "OVER" } {
      set rc [catch {eval $script} result]
      puts [list $rc $result]
      puts $l "WRITE [list $rc $result]"
      puts OVER
      puts $l "WRITE OVER"
      flush stdout
      set script ""
    } else {
      append script $line
      append script "\n"
    }
  }
  close $l
}
close $f

# 2010 June 15
#
# 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/malloc_common.tcl

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
}] {

  faultsim_delete_and_reopen

  # 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.
  #
  eval $code
  code2 { sqlite3 db2 test.db }
  code3 { sqlite3 db3 test.db }
  
  # Shorthand commands. Execute SQL using database connection [db2] or 
  # [db3]. Return the results.
  #
  proc sql1 {sql} { db eval $sql }
  proc sql2 {sql} { code2 [list db2 eval $sql] }
  proc sql3 {sql} { code3 [list db3 eval $sql] }

  proc csql1 {sql} { list [catch { sql1 $sql } msg] $msg }
  proc csql2 {sql} { list [catch { sql2 $sql } msg] $msg }
  proc csql3 {sql} { list [catch { sql3 $sql } msg] $msg }

  # Create and populate a database table using connection [db]. Check 
  # that connections [db2] and [db3] can see the schema and content.
  #
  do_test pager1-$tn.1 {
    sql1 {
      CREATE TABLE t1(a PRIMARY KEY, b);
      CREATE INDEX i1 ON t1(b);
      INSERT INTO t1 VALUES(1, 'one');
      INSERT INTO t1 VALUES(2, 'two');
    }
  } {}
  do_test pager1-$tn.2 { sql2 { SELECT * FROM t1 } } {1 one 2 two}
  do_test pager1-$tn.3 { sql3 { SELECT * FROM t1 } } {1 one 2 two}

  # Open a transaction and add a row using [db]. This puts [db] in
  # RESERVED state. Check that connections [db2] and [db3] can still
  # read the database content as it was before the transaction was
  # opened. [db] should see the inserted row.
  #
  do_test pager1-$tn.4 {
    sql1 {
      BEGIN;
        INSERT INTO t1 VALUES(3, 'three');
    }
  } {}
  do_test pager1-$tn.5 { sql2 { SELECT * FROM t1 } } {1 one 2 two}
  do_test pager1-$tn.6 { sql3 { SELECT * FROM t1 } } {1 one 2 two}
  do_test pager1-$tn.7 { sql1 { SELECT * FROM t1 } } {1 one 2 two 3 three}

  # [db] still has an open write transaction. Check that this prevents
  # other connections (specifically [db2]) from writing to the database.
  #
  # Even if [db2] opens a transaction first, it may not write to the
  # database. After the attempt to write the db within a transaction, 
  # [db2] is left with an open transaction, but not a read-lock on
  # the main database. So it does not prevent [db] from committing.
  #
  do_test pager1-$tn.8 { 
    csql2 { UPDATE t1 SET a = a + 10 }
  } {1 {database is locked}}
  do_test pager1-$tn.9 { 
    csql2 { 
      BEGIN;
      UPDATE t1 SET a = a + 10;
    }
  } {1 {database is locked}}

  # Have [db] commit its transactions. Check the other connections can
  # now see the new database content.
  #
  do_test pager1-$tn.10 { sql1 { COMMIT } } {}
  do_test pager1-$tn.11 { sql1 { SELECT * FROM t1 } } {1 one 2 two 3 three}
  do_test pager1-$tn.12 { sql2 { SELECT * FROM t1 } } {1 one 2 two 3 three}
  do_test pager1-$tn.13 { sql3 { SELECT * FROM t1 } } {1 one 2 two 3 three}

  # Check that, as noted above, [db2] really did keep an open transaction
  # after the attempt to write the database failed.
  #
  do_test pager1-$tn.14 { 
    csql2 { BEGIN } 
  } {1 {cannot start a transaction within a transaction}}
  do_test pager1-$tn.15 { sql2 { ROLLBACK } } {}

  # Have [db2] open a transaction and take a read-lock on the database.
  # Check that this prevents [db] from writing to the database (outside
  # of any transaction). After this fails, check that [db3] can read
  # the db (showing that [db] did not take a PENDING lock etc.)
  #
  do_test pager1-$tn.15 { 
    sql2 { BEGIN; SELECT * FROM t1; }
  } {1 one 2 two 3 three}
  do_test pager1-$tn.16 { 
    csql1 { UPDATE t1 SET a = a + 10 }
  } {1 {database is locked}}
  do_test pager1-$tn.17 { sql3 { SELECT * FROM t1 } } {1 one 2 two 3 three}

  # This time, have [db] open a transaction before writing the database.
  # This works - [db] gets a RESERVED lock which does not conflict with
  # the SHARED lock [db2] is holding.
  #
  do_test pager1-$tn.18 { 
    sql1 { 
      BEGIN;  
      UPDATE t1 SET a = a + 10; 
    }
  } {}
  do_test pager1-$tn-19 { 
    sql1 { PRAGMA lock_status } 
  } {main reserved temp closed}
  do_test pager1-$tn-20 { 
    sql2 { PRAGMA lock_status } 
  } {main shared temp closed}

  # Check that all connections can still read the database. Only [db] sees
  # the updated content (as the transaction has not been committed yet).
  #
  do_test pager1-$tn.21 { sql1 { SELECT * FROM t1 } } {11 one 12 two 13 three}
  do_test pager1-$tn.22 { sql2 { SELECT * FROM t1 } } {1 one 2 two 3 three}
  do_test pager1-$tn.23 { sql3 { SELECT * FROM t1 } } {1 one 2 two 3 three}

  # Because [db2] still has the SHARED lock, [db] is unable to commit the
  # transaction. If it tries, an error is returned and the connection 
  # upgrades to a PENDING lock.
  #
  # Once this happens, [db] can read the database and see the new content,
  # [db2] (still holding SHARED) can still read the old content, but [db3]
  # (not holding any lock) is prevented by [db]'s PENDING from reading
  # the database.
  #
  do_test pager1-$tn.24 { csql1 { COMMIT } } {1 {database is locked}}
  do_test pager1-$tn-25 { 
    sql1 { PRAGMA lock_status } 
  } {main pending temp closed}
  do_test pager1-$tn.26 { sql1 { SELECT * FROM t1  } } {11 one 12 two 13 three}
  do_test pager1-$tn.27 { sql2 { SELECT * FROM t1  } } {1 one 2 two 3 three}
  do_test pager1-$tn.28 { csql3 { SELECT * FROM t1 } } {1 {database is locked}}

  # Have [db2] commit its read transaction, releasing the SHARED lock it
  # is holding. Now, neither [db2] nor [db3] may read the database (as [db]
  # is still holding a PENDING).
  #
  do_test pager1-$tn.29 { sql2 { COMMIT } } {}
  do_test pager1-$tn.30 { csql2 { SELECT * FROM t1 } } {1 {database is locked}}
  do_test pager1-$tn.31 { csql3 { SELECT * FROM t1 } } {1 {database is locked}}

  # [db] is now able to commit the transaction. Once the transaction is 
  # committed, all three connections can read the new content.
  #
  do_test pager1-$tn.25 { sql1 { UPDATE t1 SET a = a+10 } } {}
  do_test pager1-$tn.26 { sql1 { COMMIT } } {}
  do_test pager1-$tn.27 { sql1 { SELECT * FROM t1 } } {21 one 22 two 23 three}
  do_test pager1-$tn.27 { sql2 { SELECT * FROM t1 } } {21 one 22 two 23 three}
  do_test pager1-$tn.28 { sql3 { SELECT * FROM t1 } } {21 one 22 two 23 three}

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

finish_test

# 2008 June 21
#
# 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
db close

#-------------------------------------------------------------------------
# test_suite NAME OPTIONS

    if {[llength $o]>1}  { error "ambiguous option: $k" }
    if {[llength $o]==0} { error "unknown option: $k" }
    set options([lindex $o 0]) $v
  }

  set     ::testspec($name) [array get options]
  lappend ::testsuitelist $name

}

#-------------------------------------------------------------------------
# test_set ARGS...
#
proc test_set {args} {
  set isExclude 0

# Define the generic test suites:
#
#   veryquick
#   quick
#   full
#   veryquick_plus_notify2
#
lappend ::testsuitelist xxx

test_suite "veryquick" -description {
  "Very" quick test suite. Runs in less than 5 minutes on a workstation. 
  This test suite is the same as the "quick" tests, except that some files
  that test malloc and IO errors are omitted.
} -files [
  test_set $allquicktests -exclude *malloc* *ioerr* *fault*

  Full test suite. Takes a long time.
} -files [ 
  test_set $alltests 
] -initialize {
  unset -nocomplain ::G(isquick)
}

lappend ::testsuitelist xxx
#-------------------------------------------------------------------------
# Define the coverage related test suites:
#
#   coverage-wal

#
test_suite "coverage-wal" -description {
  Coverage tests for file wal.c.
} -files {
  wal.test       wal2.test      wal3.test      walmode.test    
  walbak.test    walhook.test  walcrash2.test  walcksum.test
  walfault.test
} 

test_suite "coverage-pager" -description {
  Coverage tests for file pager.c.
} -files {
  pager1.test
} 


lappend ::testsuitelist xxx
#-------------------------------------------------------------------------
# Define the permutation test suites:
#

# Run some tests using pre-allocated page and scratch blocks.
#
test_suite "memsubsys1" -description {

  if {[info exists ::testspec($name)]==0} {
    error "No such test suite: $name"
  }
  uplevel run_tests $name $::testspec($name)
}

proc help {} {
  puts "Usage: $::argv0 TESTSUITE ?TESTFILE?"
  puts ""
  puts "Available test-suites are:"
  foreach k $::testsuitelist {
    if {[info exists ::testspec($k)]==0} {
      puts "         ----------------------------------------"
      puts ""
    } else {
      array set o $::testspec($k)
      puts "Test suite: \"$k\""
      set d [string trim $o(-description)]
      set d [regsub {\n *} $d "\n  "]
      puts "  $d"
      puts ""
    }
  }
  exit -1
}

if {[info script] == $argv0} {
  proc main {argv} {
    if {[llength $argv]==0} {

#
#    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 runs all tests.
#

set testdir [file dirname $argv0]
source $testdir/permutations.test





run_test_suite quick


finish_test