SQLite

#
ifcapable builtin_test {
  set MEMDEBUG 1
} else {
  set MEMDEBUG 0
  return 0
}


#--------------------------------------------------------------------------
# Usage do_faultsim_test NAME ?OPTIONS...? 
#
#     -faults           List of fault types to simulate.
#
#     -prep             Script to execute before -body.
#
#     -body             Script to execute (with fault injection).
#
#     -test             Script to execute after -body.
#
proc do_faultsim_test {name args} {
  set DEFAULT(-faults)        [list       \
    oom-transient     oom-persistent      \
    ioerr-transient   ioerr-persistent    \
  ]
  set DEFAULT(-prep)          ""
  set DEFAULT(-body)          ""
  set DEFAULT(-test)          ""

  array set O [array get DEFAULT]
  array set O $args
  foreach o [array names O] {
    if {[info exists DEFAULT($o)]==0} { error "unknown option: $o" }
  }

  set A(oom-transient) [list                 \
    -injectstart   {oom_injectstart 0}       \
    -injectstop    oom_injectstop            \
    -injecterrlist {{1 {out of memory}}}     \
  ]
  set A(oom-persistent) [list                \
    -injectstart {oom_injectstart 1000000}   \
    -injectstop oom_injectstop               \
    -injecterrlist {{1 {out of memory}}}     \
  ]
  
  set A(ioerr-transient) [list               \
    -injectstart   {ioerr_injectstart 0}     \
    -injectstop    ioerr_injectstop          \
    -injecterrlist {{1 {disk I/O error}}}    \
  ]

  set A(ioerr-persistent) [list              \
    -injectstart   {ioerr_injectstart 1}     \
    -injectstop    ioerr_injectstop          \
    -injecterrlist {{1 {disk I/O error}}}    \
  ]

  foreach f $O(-faults) {
    if {[info exists A($f)]==0} { error "unknown fault: $f" }
  }
  set testspec [list -prep $O(-prep) -body $O(-body) -test $O(-test)]
  foreach f $O(-faults) {
    eval do_one_faultsim_test "$name-$f" $A($f) $testspec
  }
}

#-------------------------------------------------------------------------
# Procedures to save and restore the current file-system state:
#
#   faultsim_save_and_close
#   faultsim_restore_and_reopen
#
proc faultsim_save_and_close {} {
  foreach {a => b} {
      test.db          =>  testX.db 
      test.db-wal      =>  testX.db-wal 
      test.db-journal  =>  testX.db-journal
  } {
    if {[file exists $a]} {
      file copy -force $a $b
    } else {
      file delete -force $b
    }
  }
  catch { db close }
  return ""
}
proc faultsim_restore_and_reopen {} {
  catch { db close }
  foreach {a => b} {
      testX.db          =>  test.db 
      testX.db-wal      =>  test.db-wal 
      testX.db-journal  =>  test.db-journal
  } {
    if {[file exists $a]} {
      file copy -force $a $b
    } else {
      file delete -force $b
    }
  }
  sqlite3 db test.db
  sqlite3_extended_result_codes db 1
  sqlite3_db_config_lookaside db 0 0 0
}


# The following procs are used as [do_faultsim_test] when injecting OOM
# faults into test cases.
#
proc oom_injectstart {nRepeat iFail} {
  sqlite3_memdebug_fail $iFail -repeat $nRepeat
}
proc oom_injectstop {} {
  sqlite3_memdebug_fail -1
}

proc ioerr_injectstart {persist iFail} {
  set ::sqlite_io_error_persist $persist
  set ::sqlite_io_error_pending $iFail
}
proc ioerr_injectstop {} {
  set sv $::sqlite_io_error_hit
  set ::sqlite_io_error_persist 0
  set ::sqlite_io_error_pending 0
  set ::sqlite_io_error_hardhit 0
  set ::sqlite_io_error_hit     0
  set ::sqlite_io_error_pending 0
  return $sv
}

# This command is not called directly. It is used by the 
# [faultsim_test_result] command created by [do_faultsim_test] and used
# by -test scripts.
#
proc faultsim_test_result_int {args} {
  upvar testrc testrc testresult testresult testnfail testnfail
  set t [list $testrc $testresult]
  set r $args
  if { ($testnfail==0 && $t != [lindex $r 0]) || [lsearch $r $t]<0 } {
    error "nfail=$testnfail rc=$testrc result=$testresult"
  }
}

#--------------------------------------------------------------------------
# Usage do_one_faultsim_test NAME ?OPTIONS...? 
#
# The first argument, <test number>, is used as a prefix of the test names
# taken by tests executed by this command. Options are as follows. All
# options take a single argument.
#
#     -injectstart      Script to enable fault-injection.
#
#     -injectstop       Script to disable fault-injection.
#
#     -injecterrlist    List of generally acceptable test results (i.e. error
#                       messages). Example: [list {1 {out of memory}}]
#
#     -prep             Script to execute before -body.
#
#     -body             Script to execute (with fault injection).
#
#     -test             Script to execute after -body.
#
proc do_one_faultsim_test {testname args} {

  set DEFAULT(-injectstart)   {oom_injectstart 0}
  set DEFAULT(-injectstop)    {oom_injectstop}
  set DEFAULT(-injecterrlist) [list {1 {out of memory}}]
  set DEFAULT(-prep)          ""
  set DEFAULT(-body)          ""
  set DEFAULT(-test)          ""

  array set O [array get DEFAULT]
  array set O $args
  foreach o [array names O] {
    if {[info exists DEFAULT($o)]==0} { error "unknown option: $o" }
  }

  proc faultsim_test_proc {testrc testresult testnfail} $O(-test)
  proc faultsim_test_result {args} "
    uplevel faultsim_test_result_int \$args [list $O(-injecterrlist)]
  "

  set stop 0
  for {set iFail 1} {!$stop} {incr iFail} {

    # Evaluate the -prep script.
    #
    eval $O(-prep)

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

ifcapable !wal {finish_test ; return }

#-------------------------------------------------------------------------
# This test case, walfault-1-*, simulates faults while executing a
#
#   PRAGMA journal_mode = WAL;
#
# statement immediately after creating a new database.
#
do_test walfault-1-pre-1 {
  db close
  file delete -force test.db test.db-wal test.db-journal
  faultsim_save_and_close
} {}
do_faultsim_test walfault-1 -prep {
  faultsim_restore_and_reopen
} -body {
  db eval { PRAGMA main.journal_mode = WAL }
} -test {

  faultsim_test_result {0 wal}

  # Test that the connection that encountered an error as part of 

  set jm2 [db2 one {SELECT * FROM sqlite_master ; PRAGMA main.journal_mode}]
  db2 close

  if { $jm!=$jm2 } { error "Journal modes do not match: $jm $jm2" }
  if { $testrc==0 && $jm!="wal" } { error "Journal mode is not WAL" }
}

#--------------------------------------------------------------------------
# Test case walfault-2-* tests fault injection during recovery of a 
# short WAL file (a dozen frames or thereabouts).
#
do_test walfault-2-pre-1 {
  sqlite3 db test.db
  execsql {
    PRAGMA journal_mode = WAL;
    BEGIN;
      CREATE TABLE x(y, z, UNIQUE(y, z));
      INSERT INTO x VALUES(randomblob(100), randomblob(100));
    COMMIT;
    PRAGMA wal_checkpoint;

    INSERT INTO x SELECT randomblob(100), randomblob(100) FROM x;
    INSERT INTO x SELECT randomblob(100), randomblob(100) FROM x;
    INSERT INTO x SELECT randomblob(100), randomblob(100) FROM x;
  }
  execsql {

    SELECT count(*) FROM x


  }
} {8}
do_test walfault-2-pre-2 {
  faultsim_save_and_close
  faultsim_restore_and_reopen
  execsql { SELECT count(*) FROM x }
} {8}
do_faultsim_test walfault-2 -prep {
  faultsim_restore_and_reopen
} -body {
  execsql { SELECT count(*) FROM x }
} -test {

  # Test that all the rows in the WAL were recovered.
  faultsim_test_result {0 8}

  # Run the integrity_check to make sure nothing strange has occurred.
  set ic [db eval { PRAGMA integrity_check }]
  if {$ic != "ok"} { error "Integrity check: $ic" }
}

#--------------------------------------------------------------------------
# Test fault injection while writing and checkpointing a small WAL file.
#
do_test walfault-3-pre-1 {
  sqlite3 db test.db
  execsql {
    PRAGMA auto_vacuum = 1;
    PRAGMA journal_mode = WAL;
    CREATE TABLE abc(a PRIMARY KEY);
    INSERT INTO abc VALUES(randomblob(1500));
  }
  db close
  faultsim_save_and_close
} {}

do_faultsim_test walfault-3 -prep {
  faultsim_restore_and_reopen
} -body {
  db eval {
    DELETE FROM abc;
    PRAGMA wal_checkpoint;
  }
} -test {
  faultsim_test_result {0 {}}
}

# A [testvfs] callback for the VFS created by [do_shmfault_test]. This
# callback injects SQLITE_IOERR faults into methods for which an entry
# in array ::shmfault_ioerr_methods is defined. For example, to enable
# errors in xShmOpen:
#
#   set ::shmfault_ioerr_methods(xShmOpen) 1