Move bundled copy of sqlite one level deeper to better separate it...

third_party/sqlite/test/tester.tcl

Index: third_party/sqlite/test/tester.tcl
===================================================================
--- third_party/sqlite/test/tester.tcl	(revision 56608)
+++ third_party/sqlite/test/tester.tcl	(working copy)
@@ -1,965 +0,0 @@
-# 2001 September 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.
-#
-#***********************************************************************
-# This file implements some common TCL routines used for regression
-# testing the SQLite library
-#
-# $Id: tester.tcl,v 1.143 2009/04/09 01:23:49 drh Exp $
-
-#
-# What for user input before continuing.  This gives an opportunity
-# to connect profiling tools to the process.
-#
-for {set i 0} {$i<[llength $argv]} {incr i} {
-  if {[regexp {^-+pause$} [lindex $argv $i] all value]} {
-    puts -nonewline "Press RETURN to begin..."
-    flush stdout
-    gets stdin
-    set argv [lreplace $argv $i $i]
-  }
-}
-
-set tcl_precision 15
-sqlite3_test_control_pending_byte 0x0010000
-
-# 
-# Check the command-line arguments for a default soft-heap-limit.
-# Store this default value in the global variable ::soft_limit and
-# update the soft-heap-limit each time this script is run.  In that
-# way if an individual test file changes the soft-heap-limit, it
-# will be reset at the start of the next test file.
-#
-if {![info exists soft_limit]} {
-  set soft_limit 0
-  for {set i 0} {$i<[llength $argv]} {incr i} {
-    if {[regexp {^--soft-heap-limit=(.+)$} [lindex $argv $i] all value]} {
-      if {$value!="off"} {
-        set soft_limit $value
-      }
-      set argv [lreplace $argv $i $i]
-    }
-  }
-}
-sqlite3_soft_heap_limit $soft_limit
-
-# 
-# Check the command-line arguments to set the memory debugger
-# backtrace depth.
-#
-# See the sqlite3_memdebug_backtrace() function in mem2.c or
-# test_malloc.c for additional information.
-#
-for {set i 0} {$i<[llength $argv]} {incr i} {
-  if {[lindex $argv $i] eq "--malloctrace"} {
-    set argv [lreplace $argv $i $i]
-    sqlite3_memdebug_backtrace 10
-    sqlite3_memdebug_log start
-    set tester_do_malloctrace 1
-  }
-}
-for {set i 0} {$i<[llength $argv]} {incr i} {
-  if {[regexp {^--backtrace=(\d+)$} [lindex $argv $i] all value]} {
-    sqlite3_memdebug_backtrace $value
-    set argv [lreplace $argv $i $i]
-  }
-}
-
-
-proc ostrace_call {zCall nClick zFile i32 i64} {
-  set s "INSERT INTO ostrace VALUES('$zCall', $nClick, '$zFile', $i32, $i64);"
-  puts $::ostrace_fd $s
-}
-
-for {set i 0} {$i<[llength $argv]} {incr i} {
-  if {[lindex $argv $i] eq "--ossummary" || [lindex $argv $i] eq "--ostrace"} {
-    sqlite3_instvfs create -default ostrace
-    set tester_do_ostrace 1
-    set ostrace_fd [open ostrace.sql w]
-    puts $ostrace_fd "BEGIN;"
-    if {[lindex $argv $i] eq "--ostrace"} {
-      set    s "CREATE TABLE ostrace"
-      append s "(method TEXT, clicks INT, file TEXT, i32 INT, i64 INT);"
-      puts $ostrace_fd $s
-      sqlite3_instvfs configure ostrace ostrace_call
-      sqlite3_instvfs configure ostrace ostrace_call
-    }
-    set argv [lreplace $argv $i $i]
-  }
-  if {[lindex $argv $i] eq "--binarylog"} {
-    set tester_do_binarylog 1
-    set argv [lreplace $argv $i $i]
-  }
-}
-
-# 
-# Check the command-line arguments to set the maximum number of
-# errors tolerated before halting.
-#
-if {![info exists maxErr]} {
-  set maxErr 1000
-}
-for {set i 0} {$i<[llength $argv]} {incr i} {
-  if {[regexp {^--maxerror=(\d+)$} [lindex $argv $i] all maxErr]} {
-    set argv [lreplace $argv $i $i]
-  }
-}
-#puts "Max error = $maxErr"
-
-
-# Use the pager codec if it is available
-#
-if {[sqlite3 -has-codec] && [info command sqlite_orig]==""} {
-  rename sqlite3 sqlite_orig
-  proc sqlite3 {args} {
-    if {[llength $args]==2 && [string index [lindex $args 0] 0]!="-"} {
-      lappend args -key {xyzzy}
-    }
-    uplevel 1 sqlite_orig $args
-  }
-}
-
-
-# Create a test database
-#
-if {![info exists nTest]} {
-  sqlite3_shutdown 
-  install_malloc_faultsim 1 
-  sqlite3_initialize
-  autoinstall_test_functions
-  if {[info exists tester_do_binarylog]} {
-    sqlite3_instvfs binarylog -default binarylog ostrace.bin
-    sqlite3_instvfs marker binarylog "$argv0 $argv"
-  }
-}
-
-proc reset_db {} {
-  catch {db close}
-  file delete -force test.db
-  file delete -force test.db-journal
-  sqlite3 db ./test.db
-  set ::DB [sqlite3_connection_pointer db]
-  if {[info exists ::SETUP_SQL]} {
-    db eval $::SETUP_SQL
-  }
-}
-reset_db
-
-# Abort early if this script has been run before.
-#
-if {[info exists nTest]} return
-
-# Set the test counters to zero
-#
-set nErr 0
-set nTest 0
-set skip_test 0
-set failList {}
-set omitList {}
-if {![info exists speedTest]} {
-  set speedTest 0
-}
-
-# Record the fact that a sequence of tests were omitted.
-#
-proc omit_test {name reason} {
-  global omitList
-  lappend omitList [list $name $reason]
-}
-
-# Invoke the do_test procedure to run a single test 
-#
-proc do_test {name cmd expected} {
-  global argv nErr nTest skip_test maxErr
-  sqlite3_memdebug_settitle $name
-  if {[info exists ::tester_do_binarylog]} {
-    sqlite3_instvfs marker binarylog "Start of $name"
-  }
-  if {$skip_test} {
-    set skip_test 0
-    return
-  }
-  if {[llength $argv]==0} { 
-    set go 1
-  } else {
-    set go 0
-    foreach pattern $argv {
-      if {[string match $pattern $name]} {
-        set go 1
-        break
-      }
-    }
-  }
-  if {!$go} return
-  incr nTest
-  puts -nonewline $name...
-  flush stdout
-  if {[catch {uplevel #0 "$cmd;\n"} result]} {
-    puts "\nError: $result"
-    incr nErr
-    lappend ::failList $name
-    if {$nErr>$maxErr} {puts "*** Giving up..."; finalize_testing}
-  } elseif {[string compare $result $expected]} {
-    puts "\nExpected: \[$expected\]\n     Got: \[$result\]"
-    incr nErr
-    lappend ::failList $name
-    if {$nErr>=$maxErr} {puts "*** Giving up..."; finalize_testing}
-  } else {
-    puts " Ok"
-  }
-  flush stdout
-  if {[info exists ::tester_do_binarylog]} {
-    sqlite3_instvfs marker binarylog "End of $name"
-  }
-}
-
-# Run an SQL script.  
-# Return the number of microseconds per statement.
-#
-proc speed_trial {name numstmt units sql} {
-  puts -nonewline [format {%-21.21s } $name...]
-  flush stdout
-  set speed [time {sqlite3_exec_nr db $sql}]
-  set tm [lindex $speed 0]
-  if {$tm == 0} {
-    set rate [format %20s "many"]
-  } else {
-    set rate [format %20.5f [expr {1000000.0*$numstmt/$tm}]]
-  }
-  set u2 $units/s
-  puts [format {%12d uS %s %s} $tm $rate $u2]
-  global total_time
-  set total_time [expr {$total_time+$tm}]
-}
-proc speed_trial_tcl {name numstmt units script} {
-  puts -nonewline [format {%-21.21s } $name...]
-  flush stdout
-  set speed [time {eval $script}]
-  set tm [lindex $speed 0]
-  if {$tm == 0} {
-    set rate [format %20s "many"]
-  } else {
-    set rate [format %20.5f [expr {1000000.0*$numstmt/$tm}]]
-  }
-  set u2 $units/s
-  puts [format {%12d uS %s %s} $tm $rate $u2]
-  global total_time
-  set total_time [expr {$total_time+$tm}]
-}
-proc speed_trial_init {name} {
-  global total_time
-  set total_time 0
-}
-proc speed_trial_summary {name} {
-  global total_time
-  puts [format {%-21.21s %12d uS TOTAL} $name $total_time]
-}
-
-# Run this routine last
-#
-proc finish_test {} {
-  finalize_testing
-}
-proc finalize_testing {} {
-  global nTest nErr sqlite_open_file_count omitList
-
-  catch {db close}
-  catch {db2 close}
-  catch {db3 close}
-
-  vfs_unlink_test
-  sqlite3 db {}
-  # sqlite3_clear_tsd_memdebug
-  db close
-  sqlite3_reset_auto_extension
-  set heaplimit [sqlite3_soft_heap_limit]
-  if {$heaplimit!=$::soft_limit} {
-    puts "soft-heap-limit changed by this script\
-          from $::soft_limit to $heaplimit"
-  } elseif {$heaplimit!="" && $heaplimit>0} {
-    puts "soft-heap-limit set to $heaplimit"
-  }
-  sqlite3_soft_heap_limit 0
-  incr nTest
-  puts "$nErr errors out of $nTest tests"
-  if {$nErr>0} {
-    puts "Failures on these tests: $::failList"
-  }
-  run_thread_tests 1
-  if {[llength $omitList]>0} {
-    puts "Omitted test cases:"
-    set prec {}
-    foreach {rec} [lsort $omitList] {
-      if {$rec==$prec} continue
-      set prec $rec
-      puts [format {  %-12s %s} [lindex $rec 0] [lindex $rec 1]]
-    }
-  }
-  if {$nErr>0 && ![working_64bit_int]} {
-    puts "******************************************************************"
-    puts "N.B.:  The version of TCL that you used to build this test harness"
-    puts "is defective in that it does not support 64-bit integers.  Some or"
-    puts "all of the test failures above might be a result from this defect"
-    puts "in your TCL build."
-    puts "******************************************************************"
-  }
-  if {[info exists ::tester_do_binarylog]} {
-    sqlite3_instvfs destroy binarylog
-  }
-  if {$sqlite_open_file_count} {
-    puts "$sqlite_open_file_count files were left open"
-    incr nErr
-  }
-  if {[info exists ::tester_do_ostrace]} {
-    puts "Writing ostrace.sql..."
-    set fd $::ostrace_fd
-
-    puts -nonewline $fd "CREATE TABLE ossummary"
-    puts $fd "(method TEXT, clicks INTEGER, count INTEGER);"
-    foreach row [sqlite3_instvfs report ostrace] {
-      foreach {method count clicks} $row break
-      puts $fd "INSERT INTO ossummary VALUES('$method', $clicks, $count);"
-    }
-    puts $fd "COMMIT;"
-    close $fd
-    sqlite3_instvfs destroy ostrace
-  }
-  if {[sqlite3_memory_used]>0} {
-    puts "Unfreed memory: [sqlite3_memory_used] bytes"
-    incr nErr
-    ifcapable memdebug||mem5||(mem3&&debug) {
-      puts "Writing unfreed memory log to \"./memleak.txt\""
-      sqlite3_memdebug_dump ./memleak.txt
-    }
-  } else {
-    puts "All memory allocations freed - no leaks"
-    ifcapable memdebug||mem5 {
-      sqlite3_memdebug_dump ./memusage.txt
-    }
-  }
-  show_memstats
-  puts "Maximum memory usage: [sqlite3_memory_highwater 1] bytes"
-  puts "Current memory usage: [sqlite3_memory_highwater] bytes"
-  if {[info commands sqlite3_memdebug_malloc_count] ne ""} {
-    puts "Number of malloc()  : [sqlite3_memdebug_malloc_count] calls"
-  }
-  if {[info exists ::tester_do_malloctrace]} {
-    puts "Writing mallocs.sql..."
-    memdebug_log_sql
-    sqlite3_memdebug_log stop
-    sqlite3_memdebug_log clear
-
-    if {[sqlite3_memory_used]>0} {
-      puts "Writing leaks.sql..."
-      sqlite3_memdebug_log sync
-      memdebug_log_sql leaks.sql
-    }
-  }
-  foreach f [glob -nocomplain test.db-*-journal] {
-    file delete -force $f
-  }
-  foreach f [glob -nocomplain test.db-mj*] {
-    file delete -force $f
-  }
-  exit [expr {$nErr>0}]
-}
-
-# Display memory statistics for analysis and debugging purposes.
-#
-proc show_memstats {} {
-  set x [sqlite3_status SQLITE_STATUS_MEMORY_USED 0]
-  set y [sqlite3_status SQLITE_STATUS_MALLOC_SIZE 0]
-  set val [format {now %10d  max %10d  max-size %10d} \
-              [lindex $x 1] [lindex $x 2] [lindex $y 2]]
-  puts "Memory used:          $val"
-  set x [sqlite3_status SQLITE_STATUS_PAGECACHE_USED 0]
-  set y [sqlite3_status SQLITE_STATUS_PAGECACHE_SIZE 0]
-  set val [format {now %10d  max %10d  max-size %10d} \
-              [lindex $x 1] [lindex $x 2] [lindex $y 2]]
-  puts "Page-cache used:      $val"
-  set x [sqlite3_status SQLITE_STATUS_PAGECACHE_OVERFLOW 0]
-  set val [format {now %10d  max %10d} [lindex $x 1] [lindex $x 2]]
-  puts "Page-cache overflow:  $val"
-  set x [sqlite3_status SQLITE_STATUS_SCRATCH_USED 0]
-  set val [format {now %10d  max %10d} [lindex $x 1] [lindex $x 2]]
-  puts "Scratch memory used:  $val"
-  set x [sqlite3_status SQLITE_STATUS_SCRATCH_OVERFLOW 0]
-  set y [sqlite3_status SQLITE_STATUS_SCRATCH_SIZE 0]
-  set val [format {now %10d  max %10d  max-size %10d} \
-               [lindex $x 1] [lindex $x 2] [lindex $y 2]]
-  puts "Scratch overflow:     $val"
-  ifcapable yytrackmaxstackdepth {
-    set x [sqlite3_status SQLITE_STATUS_PARSER_STACK 0]
-    set val [format {               max %10d} [lindex $x 2]]
-    puts "Parser stack depth:    $val"
-  }
-}
-
-# A procedure to execute SQL
-#
-proc execsql {sql {db db}} {
-  # puts "SQL = $sql"
-  uplevel [list $db eval $sql]
-}
-
-# Execute SQL and catch exceptions.
-#
-proc catchsql {sql {db db}} {
-  # puts "SQL = $sql"
-  set r [catch {$db eval $sql} msg]
-  lappend r $msg
-  return $r
-}
-
-# Do an VDBE code dump on the SQL given
-#
-proc explain {sql {db db}} {
-  puts ""
-  puts "addr  opcode        p1      p2      p3      p4               p5  #"
-  puts "----  ------------  ------  ------  ------  ---------------  --  -"
-  $db eval "explain $sql" {} {
-    puts [format {%-4d  %-12.12s  %-6d  %-6d  %-6d  % -17s %s  %s} \
-      $addr $opcode $p1 $p2 $p3 $p4 $p5 $comment
-    ]
-  }
-}
-
-# Show the VDBE program for an SQL statement but omit the Trace
-# opcode at the beginning.  This procedure can be used to prove
-# that different SQL statements generate exactly the same VDBE code.
-#
-proc explain_no_trace {sql} {
-  set tr [db eval "EXPLAIN $sql"]
-  return [lrange $tr 7 end]
-}
-
-# Another procedure to execute SQL.  This one includes the field
-# names in the returned list.
-#
-proc execsql2 {sql} {
-  set result {}
-  db eval $sql data {
-    foreach f $data(*) {
-      lappend result $f $data($f)
-    }
-  }
-  return $result
-}
-
-# Use the non-callback API to execute multiple SQL statements
-#
-proc stepsql {dbptr sql} {
-  set sql [string trim $sql]
-  set r 0
-  while {[string length $sql]>0} {
-    if {[catch {sqlite3_prepare $dbptr $sql -1 sqltail} vm]} {
-      return [list 1 $vm]
-    }
-    set sql [string trim $sqltail]
-#    while {[sqlite_step $vm N VAL COL]=="SQLITE_ROW"} {
-#      foreach v $VAL {lappend r $v}
-#    }
-    while {[sqlite3_step $vm]=="SQLITE_ROW"} {
-      for {set i 0} {$i<[sqlite3_data_count $vm]} {incr i} {
-        lappend r [sqlite3_column_text $vm $i]
-      }
-    }
-    if {[catch {sqlite3_finalize $vm} errmsg]} {
-      return [list 1 $errmsg]
-    }
-  }
-  return $r
-}
-
-# Delete a file or directory
-#
-proc forcedelete {filename} {
-  if {[catch {file delete -force $filename}]} {
-    exec rm -rf $filename
-  }
-}
-
-# Do an integrity check of the entire database
-#
-proc integrity_check {name {db db}} {
-  ifcapable integrityck {
-    do_test $name [list execsql {PRAGMA integrity_check} $db] {ok}
-  }
-}
-
-proc fix_ifcapable_expr {expr} {
-  set ret ""
-  set state 0
-  for {set i 0} {$i < [string length $expr]} {incr i} {
-    set char [string range $expr $i $i]
-    set newstate [expr {[string is alnum $char] || $char eq "_"}]
-    if {$newstate && !$state} {
-      append ret {$::sqlite_options(}
-    }
-    if {!$newstate && $state} {
-      append ret )
-    }
-    append ret $char
-    set state $newstate
-  }
-  if {$state} {append ret )}
-  return $ret
-}
-
-# Evaluate a boolean expression of capabilities.  If true, execute the
-# code.  Omit the code if false.
-#
-proc ifcapable {expr code {else ""} {elsecode ""}} {
-  #regsub -all {[a-z_0-9]+} $expr {$::sqlite_options(&)} e2
-  set e2 [fix_ifcapable_expr $expr]
-  if ($e2) {
-    set c [catch {uplevel 1 $code} r]
-  } else {
-    set c [catch {uplevel 1 $elsecode} r]
-  }
-  return -code $c $r
-}
-
-# This proc execs a seperate process that crashes midway through executing
-# the SQL script $sql on database test.db.
-#
-# The crash occurs during a sync() of file $crashfile. When the crash
-# occurs a random subset of all unsynced writes made by the process are
-# written into the files on disk. Argument $crashdelay indicates the
-# number of file syncs to wait before crashing.
-#
-# The return value is a list of two elements. The first element is a
-# boolean, indicating whether or not the process actually crashed or
-# reported some other error. The second element in the returned list is the
-# error message. This is "child process exited abnormally" if the crash
-# occured.
-#
-#   crashsql -delay CRASHDELAY -file CRASHFILE ?-blocksize BLOCKSIZE? $sql
-#
-proc crashsql {args} {
-  if {$::tcl_platform(platform)!="unix"} {
-    error "crashsql should only be used on unix"
-  }
-
-  set blocksize ""
-  set crashdelay 1
-  set prngseed 0
-  set tclbody {}
-  set crashfile ""
-  set dc ""
-  set sql [lindex $args end]
-  
-  for {set ii 0} {$ii < [llength $args]-1} {incr ii 2} {
-    set z [lindex $args $ii]
-    set n [string length $z]
-    set z2 [lindex $args [expr $ii+1]]
-
-    if     {$n>1 && [string first $z -delay]==0}     {set crashdelay $z2} \
-    elseif {$n>1 && [string first $z -seed]==0}      {set prngseed $z2} \
-    elseif {$n>1 && [string first $z -file]==0}      {set crashfile $z2}  \
-    elseif {$n>1 && [string first $z -tclbody]==0}   {set tclbody $z2}  \
-    elseif {$n>1 && [string first $z -blocksize]==0} {set blocksize "-s $z2" } \
-    elseif {$n>1 && [string first $z -characteristics]==0} {set dc "-c {$z2}" } \
-    else   { error "Unrecognized option: $z" }
-  }
-
-  if {$crashfile eq ""} {
-    error "Compulsory option -file missing"
-  }
-
-  set cfile [file join [pwd] $crashfile]
-
-  set f [open crash.tcl w]
-  puts $f "sqlite3_crash_enable 1"
-  puts $f "sqlite3_crashparams $blocksize $dc $crashdelay $cfile"
-  puts $f "sqlite3_test_control_pending_byte $::sqlite_pending_byte"
-  puts $f "sqlite3 db test.db -vfs crash"
-
-  # This block sets the cache size of the main database to 10
-  # pages. This is done in case the build is configured to omit
-  # "PRAGMA cache_size".
-  puts $f {db eval {SELECT * FROM sqlite_master;}}
-  puts $f {set bt [btree_from_db db]}
-  puts $f {btree_set_cache_size $bt 10}
-  if {$prngseed} {
-    set seed [expr {$prngseed%10007+1}]
-    # puts seed=$seed
-    puts $f "db eval {SELECT randomblob($seed)}"
-  }
-
-  if {[string length $tclbody]>0} {
-    puts $f $tclbody
-  }
-  if {[string length $sql]>0} {
-    puts $f "db eval {"
-    puts $f   "$sql"
-    puts $f "}"
-  }
-  close $f
-
-  set r [catch {
-    exec [info nameofexec] crash.tcl >@stdout
-  } msg]
-  lappend r $msg
-}
-
-# Usage: do_ioerr_test <test number> <options...>
-#
-# This proc is used to implement test cases that check that IO errors
-# are correctly handled. The first argument, <test number>, is an integer 
-# used to name the tests executed by this proc. Options are as follows:
-#
-#     -tclprep          TCL script to run to prepare test.
-#     -sqlprep          SQL script to run to prepare test.
-#     -tclbody          TCL script to run with IO error simulation.
-#     -sqlbody          TCL script to run with IO error simulation.
-#     -exclude          List of 'N' values not to test.
-#     -erc              Use extended result codes
-#     -persist          Make simulated I/O errors persistent
-#     -start            Value of 'N' to begin with (default 1)
-#
-#     -cksum            Boolean. If true, test that the database does
-#                       not change during the execution of the test case.
-#
-proc do_ioerr_test {testname args} {
-
-  set ::ioerropts(-start) 1
-  set ::ioerropts(-cksum) 0
-  set ::ioerropts(-erc) 0
-  set ::ioerropts(-count) 100000000
-  set ::ioerropts(-persist) 1
-  set ::ioerropts(-ckrefcount) 0
-  set ::ioerropts(-restoreprng) 1
-  array set ::ioerropts $args
-
-  # TEMPORARY: For 3.5.9, disable testing of extended result codes. There are
-  # a couple of obscure IO errors that do not return them.
-  set ::ioerropts(-erc) 0
-
-  set ::go 1
-  #reset_prng_state
-  save_prng_state
-  for {set n $::ioerropts(-start)} {$::go} {incr n} {
-    set ::TN $n
-    incr ::ioerropts(-count) -1
-    if {$::ioerropts(-count)<0} break
- 
-    # Skip this IO error if it was specified with the "-exclude" option.
-    if {[info exists ::ioerropts(-exclude)]} {
-      if {[lsearch $::ioerropts(-exclude) $n]!=-1} continue
-    }
-    if {$::ioerropts(-restoreprng)} {
-      restore_prng_state
-    }
-
-    # Delete the files test.db and test2.db, then execute the TCL and 
-    # SQL (in that order) to prepare for the test case.
-    do_test $testname.$n.1 {
-      set ::sqlite_io_error_pending 0
-      catch {db close}
-      catch {db2 close}
-      catch {file delete -force test.db}
-      catch {file delete -force test.db-journal}
-      catch {file delete -force test2.db}
-      catch {file delete -force test2.db-journal}
-      set ::DB [sqlite3 db test.db; sqlite3_connection_pointer db]
-      sqlite3_extended_result_codes $::DB $::ioerropts(-erc)
-      if {[info exists ::ioerropts(-tclprep)]} {
-        eval $::ioerropts(-tclprep)
-      }
-      if {[info exists ::ioerropts(-sqlprep)]} {
-        execsql $::ioerropts(-sqlprep)
-      }
-      expr 0
-    } {0}
-
-    # Read the 'checksum' of the database.
-    if {$::ioerropts(-cksum)} {
-      set checksum [cksum]
-    }
-
-    # Set the Nth IO error to fail.
-    do_test $testname.$n.2 [subst {
-      set ::sqlite_io_error_persist $::ioerropts(-persist)
-      set ::sqlite_io_error_pending $n
-    }] $n
-  
-    # Create a single TCL script from the TCL and SQL specified
-    # as the body of the test.
-    set ::ioerrorbody {}
-    if {[info exists ::ioerropts(-tclbody)]} {
-      append ::ioerrorbody "$::ioerropts(-tclbody)\n"
-    }
-    if {[info exists ::ioerropts(-sqlbody)]} {
-      append ::ioerrorbody "db eval {$::ioerropts(-sqlbody)}"
-    }
-
-    # Execute the TCL Script created in the above block. If
-    # there are at least N IO operations performed by SQLite as
-    # a result of the script, the Nth will fail.
-    do_test $testname.$n.3 {
-      set ::sqlite_io_error_hit 0
-      set ::sqlite_io_error_hardhit 0
-      set r [catch $::ioerrorbody msg]
-      set ::errseen $r
-      set rc [sqlite3_errcode $::DB]
-      if {$::ioerropts(-erc)} {
-        # If we are in extended result code mode, make sure all of the
-        # IOERRs we get back really do have their extended code values.
-        # If an extended result code is returned, the sqlite3_errcode
-        # TCLcommand will return a string of the form:  SQLITE_IOERR+nnnn
-        # where nnnn is a number
-        if {[regexp {^SQLITE_IOERR} $rc] && ![regexp {IOERR\+\d} $rc]} {
-          return $rc
-        }
-      } else {
-        # If we are not in extended result code mode, make sure no
-        # extended error codes are returned.
-        if {[regexp {\+\d} $rc]} {
-          return $rc
-        }
-      }
-      # The test repeats as long as $::go is non-zero.  $::go starts out
-      # as 1.  When a test runs to completion without hitting an I/O
-      # error, that means there is no point in continuing with this test
-      # case so set $::go to zero.
-      #
-      if {$::sqlite_io_error_pending>0} {
-        set ::go 0
-        set q 0
-        set ::sqlite_io_error_pending 0
-      } else {
-        set q 1
-      }
-
-      set s [expr $::sqlite_io_error_hit==0]
-      if {$::sqlite_io_error_hit>$::sqlite_io_error_hardhit && $r==0} {
-        set r 1
-      }
-      set ::sqlite_io_error_hit 0
-
-      # One of two things must have happened. either
-      #   1.  We never hit the IO error and the SQL returned OK
-      #   2.  An IO error was hit and the SQL failed
-      #
-      expr { ($s && !$r && !$q) || (!$s && $r && $q) }
-    } {1}
-
-    set ::sqlite_io_error_hit 0
-    set ::sqlite_io_error_pending 0
-
-    # Check that no page references were leaked. There should be 
-    # a single reference if there is still an active transaction, 
-    # or zero otherwise.
-    #
-    # UPDATE: If the IO error occurs after a 'BEGIN' but before any
-    # locks are established on database files (i.e. if the error 
-    # occurs while attempting to detect a hot-journal file), then
-    # there may 0 page references and an active transaction according
-    # to [sqlite3_get_autocommit].
-    #
-    if {$::go && $::sqlite_io_error_hardhit && $::ioerropts(-ckrefcount)} {
-      do_test $testname.$n.4 {
-        set bt [btree_from_db db]
-        db_enter db
-        array set stats [btree_pager_stats $bt]
-        db_leave db
-        set nRef $stats(ref)
-        expr {$nRef == 0 || ([sqlite3_get_autocommit db]==0 && $nRef == 1)}
-      } {1}
-    }
-
-    # If there is an open database handle and no open transaction, 
-    # and the pager is not running in exclusive-locking mode,
-    # check that the pager is in "unlocked" state. Theoretically,
-    # if a call to xUnlock() failed due to an IO error the underlying
-    # file may still be locked.
-    #
-    ifcapable pragma {
-      if { [info commands db] ne ""
-        && $::ioerropts(-ckrefcount)
-        && [db one {pragma locking_mode}] eq "normal"
-        && [sqlite3_get_autocommit db]
-      } {
-        do_test $testname.$n.5 {
-          set bt [btree_from_db db]
-          db_enter db
-          array set stats [btree_pager_stats $bt]
-          db_leave db
-          set stats(state)
-        } 0
-      }
-    }
-
-    # If an IO error occured, then the checksum of the database should
-    # be the same as before the script that caused the IO error was run.
-    #
-    if {$::go && $::sqlite_io_error_hardhit && $::ioerropts(-cksum)} {
-      do_test $testname.$n.6 {
-        catch {db close}
-        catch {db2 close}
-        set ::DB [sqlite3 db test.db; sqlite3_connection_pointer db]
-        cksum
-      } $checksum
-    }
-
-    set ::sqlite_io_error_hardhit 0
-    set ::sqlite_io_error_pending 0
-    if {[info exists ::ioerropts(-cleanup)]} {
-      catch $::ioerropts(-cleanup)
-    }
-  }
-  set ::sqlite_io_error_pending 0
-  set ::sqlite_io_error_persist 0
-  unset ::ioerropts
-}
-
-# Return a checksum based on the contents of the main database associated
-# with connection $db
-#
-proc cksum {{db db}} {
-  set txt [$db eval {
-      SELECT name, type, sql FROM sqlite_master order by name
-  }]\n
-  foreach tbl [$db eval {
-      SELECT name FROM sqlite_master WHERE type='table' order by name
-  }] {
-    append txt [$db eval "SELECT * FROM $tbl"]\n
-  }
-  foreach prag {default_synchronous default_cache_size} {
-    append txt $prag-[$db eval "PRAGMA $prag"]\n
-  }
-  set cksum [string length $txt]-[md5 $txt]
-  # puts $cksum-[file size test.db]
-  return $cksum
-}
-
-# Generate a checksum based on the contents of the main and temp tables
-# database $db. If the checksum of two databases is the same, and the
-# integrity-check passes for both, the two databases are identical.
-#
-proc allcksum {{db db}} {
-  set ret [list]
-  ifcapable tempdb {
-    set sql {
-      SELECT name FROM sqlite_master WHERE type = 'table' UNION
-      SELECT name FROM sqlite_temp_master WHERE type = 'table' UNION
-      SELECT 'sqlite_master' UNION
-      SELECT 'sqlite_temp_master' ORDER BY 1
-    }
-  } else {
-    set sql {
-      SELECT name FROM sqlite_master WHERE type = 'table' UNION
-      SELECT 'sqlite_master' ORDER BY 1
-    }
-  }
-  set tbllist [$db eval $sql]
-  set txt {}
-  foreach tbl $tbllist {
-    append txt [$db eval "SELECT * FROM $tbl"]
-  }
-  foreach prag {default_cache_size} {
-    append txt $prag-[$db eval "PRAGMA $prag"]\n
-  }
-  # puts txt=$txt
-  return [md5 $txt]
-}
-
-# Generate a checksum based on the contents of a single database with
-# a database connection.  The name of the database is $dbname.  
-# Examples of $dbname are "temp" or "main".
-#
-proc dbcksum {db dbname} {
-  if {$dbname=="temp"} {
-    set master sqlite_temp_master
-  } else {
-    set master $dbname.sqlite_master
-  }
-  set alltab [$db eval "SELECT name FROM $master WHERE type='table'"]
-  set txt [$db eval "SELECT * FROM $master"]\n
-  foreach tab $alltab {
-    append txt [$db eval "SELECT * FROM $dbname.$tab"]\n
-  }
-  return [md5 $txt]
-}
-
-proc memdebug_log_sql {{filename mallocs.sql}} {
-
-  set data [sqlite3_memdebug_log dump]
-  set nFrame [expr [llength [lindex $data 0]]-2]
-  if {$nFrame < 0} { return "" }
-
-  set database temp
-
-  set tbl "CREATE TABLE ${database}.malloc(zTest, nCall, nByte, lStack);"
-
-  set sql ""
-  foreach e $data {
-    set nCall [lindex $e 0]
-    set nByte [lindex $e 1]
-    set lStack [lrange $e 2 end]
-    append sql "INSERT INTO ${database}.malloc VALUES"
-    append sql "('test', $nCall, $nByte, '$lStack');\n"
-    foreach f $lStack {
-      set frames($f) 1
-    }
-  }
-
-  set tbl2 "CREATE TABLE ${database}.frame(frame INTEGER PRIMARY KEY, line);\n"
-  set tbl3 "CREATE TABLE ${database}.file(name PRIMARY KEY, content);\n"
-
-  foreach f [array names frames] {
-    set addr [format %x $f]
-    set cmd "addr2line -e [info nameofexec] $addr"
-    set line [eval exec $cmd]
-    append sql "INSERT INTO ${database}.frame VALUES($f, '$line');\n"
-
-    set file [lindex [split $line :] 0]
-    set files($file) 1
-  }
-
-  foreach f [array names files] {
-    set contents ""
-    catch {
-      set fd [open $f]
-      set contents [read $fd]
-      close $fd
-    }
-    set contents [string map {' ''} $contents]
-    append sql "INSERT INTO ${database}.file VALUES('$f', '$contents');\n"
-  }
-
-  set fd [open $filename w]
-  puts $fd "BEGIN; ${tbl}${tbl2}${tbl3}${sql} ; COMMIT;"
-  close $fd
-}
-
-# Copy file $from into $to. This is used because some versions of
-# TCL for windows (notably the 8.4.1 binary package shipped with the
-# current mingw release) have a broken "file copy" command.
-#
-proc copy_file {from to} {
-  if {$::tcl_platform(platform)=="unix"} {
-    file copy -force $from $to
-  } else {
-    set f [open $from]
-    fconfigure $f -translation binary
-    set t [open $to w]
-    fconfigure $t -translation binary
-    puts -nonewline $t [read $f [file size $from]]
-    close $t
-    close $f
-  }
-}
-
-# If the library is compiled with the SQLITE_DEFAULT_AUTOVACUUM macro set
-# to non-zero, then set the global variable $AUTOVACUUM to 1.
-set AUTOVACUUM $sqlite_options(default_autovacuum)
-
-source $testdir/thread_common.tcl