# 2001 September 15

 #

 # Portions Copyright (c) 2007-2010 Nokia Corporation and/or its subsidiaries. All rights reserved.

 #

 # 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.134 2008/08/05 17:53:24 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

 set sqlite_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

   if {[info exists tester_do_binarylog]} {

     sqlite3_instvfs binarylog -default binarylog ostrace.bin

     sqlite3_instvfs marker binarylog "$argv0 $argv"

   }

 }

 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

 }

 # Abort early if this script has been run before.

 #

 if {[info exists nTest]} return

 # Symbian OS globals

 set case_failure 0

 set nCases 0

 set nFailedCases 0

 # 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]

 }

 # Symbian OS: Added procedures to output test result in TEF format

 puts "<pre>"

 # Symbian OS: global procedure to handle test errors counter

 proc do_fail {name} {

   global case_failure nErr failList

   set case_failure 1

   incr nErr

   lappend ::failList $name

 }

 # Symbian OS: global procedure to output START_TESTCASE in TEF format

 proc start_case {name} {

   global case_failure nCases

   set case_failure 0

   incr nCases

   puts "<font color=00AF00> START_TESTCASE $name <\/font>"

 }

 # Symbian OS: global procedure to output END_TESTCASE in TEF format

 proc end_case {name} {

   global case_failure nFailedCases

   if {$case_failure} {

     incr nFailedCases

     puts "<font color=FF0000> END_TESTCASE $name ***TestCaseResult = FAIL <\/font>"

   } else {

     puts "<font color=00AF00> END_TESTCASE $name ***TestCaseResult = PASS <\/font>"

   }

 }

 # Symbian OS: global procedure to output test summary in TEF format

 proc tef_summary {} {

   global nCases nFailedCases

   set nPass [expr "$nCases - $nFailedCases"]

   puts "<font color=00AFFF>TEST STEP SUMMARY:<\/font>"

   puts "<font color=00AF00>PASS = $nCases<\/font>"

   puts "<font color=FF0000>FAIL = $nFailedCases<\/font>"

   puts "<font color=00AFFF>TEST CASE SUMMARY:<\/font>"

   puts "<font color=00AF00>PASS = $nCases<\/font>"

   puts "<font color=FF0000>FAIL = $nFailedCases<\/font>"

   puts "<\/pre>"

   flush stdout

 }

 # 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"

     # Symbian OS: Set and increase error count with do_fail procedure (definition in Tester.tcl)

     do_fail $name 

     print_text $name "FAILED"  

     if {$nErr>$maxErr} {puts "*** Giving up..."; finalize_testing}

   } elseif {[string compare $result $expected]} {

     puts "\nExpected: \[$expected\]\n     Got: \[$result\]"

     # Symbian OS: Set and increase error count with do_fail procedure (definition in Tester.tcl)

     do_fail $name 

     print_text $name "FAILED"  

     if {$nErr>=$maxErr} {puts "*** Giving up..."; finalize_testing}

   } else {

     puts " Ok"

     print_text $name "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"

   }

   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

   }

 #Symbian OS - delete_test_files() is called to cleanup after the tests execution

   delete_test_files

 # Symbian OS: output TEF format summary

   tef_summary

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

   ifcapable integrityck {

     do_test $name {

       execsql {PRAGMA integrity_check}

     } {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 "set sqlite_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 && $n<200} {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 {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]

 }

 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(nCall, nByte"

   for {set ii 1} {$ii <= $nFrame} {incr ii} {

     append tbl ", f${ii}"

   }

   append tbl ");\n"

   set sql ""

   foreach e $data {

     append sql "INSERT INTO ${database}.malloc VALUES([join $e ,]);\n"

     foreach f [lrange $e 2 end] {

       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)