Import SQLite 3.8.7.4.

third_party/sqlite/src/test/tester.tcl

Index: third_party/sqlite/src/test/tester.tcl
diff --git a/third_party/sqlite/src/test/tester.tcl b/third_party/sqlite/src/test/tester.tcl
index bae10530c6b30a3ed6a0d733c7523652fb26dc7e..dad22661bdeb89c130b335d29a05cdfdcb5f90ff 100644
--- a/third_party/sqlite/src/test/tester.tcl
+++ b/third_party/sqlite/src/test/tester.tcl
@@ -14,18 +14,24 @@
 # $Id: tester.tcl,v 1.143 2009/04/09 01:23:49 drh Exp $
 
 #-------------------------------------------------------------------------
-# The commands provided by the code in this file to help with creating 
+# The commands provided by the code in this file to help with creating
 # test cases are as follows:
 #
 # Commands to manipulate the db and the file-system at a high level:
 #
+#      is_relative_file
+#      test_pwd
+#      get_pwd
 #      copy_file              FROM TO
-#      drop_all_table         ?DB?
+#      delete_file            FILENAME
+#      drop_all_tables        ?DB?
+#      forcecopy              FROM TO
 #      forcedelete            FILENAME
 #
 # Test the capability of the SQLite version built into the interpreter to
 # determine if a specific test can be run:
 #
+#      capable                EXPR
 #      ifcapable              EXPR
 #
 # Calulate checksums based on database contents:
@@ -36,6 +42,7 @@
 #
 # Commands to execute/explain SQL statements:
 #
+#      memdbsql               SQL
 #      stepsql                DB SQL
 #      execsql2               SQL
 #      explain_no_trace       SQL
@@ -48,14 +55,16 @@
 #      do_ioerr_test          TESTNAME ARGS...
 #      crashsql               ARGS...
 #      integrity_check        TESTNAME ?DB?
+#      verify_ex_errcode      TESTNAME EXPECTED ?DB?
 #      do_test                TESTNAME SCRIPT EXPECTED
 #      do_execsql_test        TESTNAME SQL EXPECTED
 #      do_catchsql_test       TESTNAME SQL EXPECTED
+#      do_timed_execsql_test  TESTNAME SQL EXPECTED
 #
 # Commands providing a lower level interface to the global test counters:
 #
 #      set_test_counter       COUNTER ?VALUE?
-#      omit_test              TESTNAME REASON
+#      omit_test              TESTNAME REASON ?APPEND?
 #      fail_test              TESTNAME
 #      incr_ntest
 #
@@ -73,7 +82,7 @@
 #      presql
 #
 
-# Set the precision of FP arithmatic used by the interpreter. And 
+# Set the precision of FP arithmatic used by the interpreter. And
 # configure SQLite to take database file locks on the page that begins
 # 64KB into the database file instead of the one 1GB in. This means
 # the code that handles that special case can be tested without creating
@@ -83,7 +92,7 @@ set tcl_precision 15
 sqlite3_test_control_pending_byte 0x0010000
 
 
-# If the pager codec is available, create a wrapper for the [sqlite3] 
+# If the pager codec is available, create a wrapper for the [sqlite3]
 # command that appends "-key {xyzzy}" to the command line. i.e. this:
 #
 #     sqlite3 db test.db
@@ -115,14 +124,235 @@ if {[info command sqlite_orig]==""} {
       }
       set res
     } else {
-      # This command is not opening a new database connection. Pass the 
-      # arguments through to the C implemenation as the are.
+      # This command is not opening a new database connection. Pass the
+      # arguments through to the C implementation as the are.
       #
       uplevel 1 sqlite_orig $args
     }
   }
 }
 
+proc getFileRetries {} {
+  if {![info exists ::G(file-retries)]} {
+    #
+    # NOTE: Return the default number of retries for [file] operations.  A
+    #       value of zero or less here means "disabled".
+    #
+    return [expr {$::tcl_platform(platform) eq "windows" ? 50 : 0}]
+  }
+  return $::G(file-retries)
+}
+
+proc getFileRetryDelay {} {
+  if {![info exists ::G(file-retry-delay)]} {
+    #
+    # NOTE: Return the default number of milliseconds to wait when retrying
+    #       failed [file] operations.  A value of zero or less means "do not
+    #       wait".
+    #
+    return 100; # TODO: Good default?
+  }
+  return $::G(file-retry-delay)
+}
+
+# Return the string representing the name of the current directory.  On
+# Windows, the result is "normalized" to whatever our parent command shell
+# is using to prevent case-mismatch issues.
+#
+proc get_pwd {} {
+  if {$::tcl_platform(platform) eq "windows"} {
+    #
+    # NOTE: Cannot use [file normalize] here because it would alter the
+    #       case of the result to what Tcl considers canonical, which would
+    #       defeat the purpose of this procedure.
+    #
+    return [string map [list \\ /] \
+        [string trim [exec -- $::env(ComSpec) /c echo %CD%]]]
+  } else {
+    return [pwd]
+  }
+}
+
+# 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} {
+  do_copy_file false $from $to
+}
+
+proc forcecopy {from to} {
+  do_copy_file true $from $to
+}
+
+proc do_copy_file {force from to} {
+  set nRetry [getFileRetries]     ;# Maximum number of retries.
+  set nDelay [getFileRetryDelay]  ;# Delay in ms before retrying.
+
+  # On windows, sometimes even a [file copy -force] can fail. The cause is
+  # usually "tag-alongs" - programs like anti-virus software, automatic backup
+  # tools and various explorer extensions that keep a file open a little longer
+  # than we expect, causing the delete to fail.
+  #
+  # The solution is to wait a short amount of time before retrying the copy.
+  #
+  if {$nRetry > 0} {
+    for {set i 0} {$i<$nRetry} {incr i} {
+      set rc [catch {
+        if {$force} {
+          file copy -force $from $to
+        } else {
+          file copy $from $to
+        }
+      } msg]
+      if {$rc==0} break
+      if {$nDelay > 0} { after $nDelay }
+    }
+    if {$rc} { error $msg }
+  } else {
+    if {$force} {
+      file copy -force $from $to
+    } else {
+      file copy $from $to
+    }
+  }
+}
+
+# Check if a file name is relative
+#
+proc is_relative_file { file } {
+  return [expr {[file pathtype $file] != "absolute"}]
+}
+
+# If the VFS supports using the current directory, returns [pwd];
+# otherwise, it returns only the provided suffix string (which is
+# empty by default).
+#
+proc test_pwd { args } {
+  if {[llength $args] > 0} {
+    set suffix1 [lindex $args 0]
+    if {[llength $args] > 1} {
+      set suffix2 [lindex $args 1]
+    } else {
+      set suffix2 $suffix1
+    }
+  } else {
+    set suffix1 ""; set suffix2 ""
+  }
+  ifcapable curdir {
+    return "[get_pwd]$suffix1"
+  } else {
+    return $suffix2
+  }
+}
+
+# Delete a file or directory
+#
+proc delete_file {args} {
+  do_delete_file false {*}$args
+}
+
+proc forcedelete {args} {
+  do_delete_file true {*}$args
+}
+
+proc do_delete_file {force args} {
+  set nRetry [getFileRetries]     ;# Maximum number of retries.
+  set nDelay [getFileRetryDelay]  ;# Delay in ms before retrying.
+
+  foreach filename $args {
+    # On windows, sometimes even a [file delete -force] can fail just after
+    # a file is closed. The cause is usually "tag-alongs" - programs like
+    # anti-virus software, automatic backup tools and various explorer
+    # extensions that keep a file open a little longer than we expect, causing
+    # the delete to fail.
+    #
+    # The solution is to wait a short amount of time before retrying the
+    # delete.
+    #
+    if {$nRetry > 0} {
+      for {set i 0} {$i<$nRetry} {incr i} {
+        set rc [catch {
+          if {$force} {
+            file delete -force $filename
+          } else {
+            file delete $filename
+          }
+        } msg]
+        if {$rc==0} break
+        if {$nDelay > 0} { after $nDelay }
+      }
+      if {$rc} { error $msg }
+    } else {
+      if {$force} {
+        file delete -force $filename
+      } else {
+        file delete $filename
+      }
+    }
+  }
+}
+
+if {$::tcl_platform(platform) eq "windows"} {
+  proc do_remove_win32_dir {args} {
+    set nRetry [getFileRetries]     ;# Maximum number of retries.
+    set nDelay [getFileRetryDelay]  ;# Delay in ms before retrying.
+
+    foreach dirName $args {
+      # On windows, sometimes even a [remove_win32_dir] can fail just after
+      # a directory is emptied. The cause is usually "tag-alongs" - programs
+      # like anti-virus software, automatic backup tools and various explorer
+      # extensions that keep a file open a little longer than we expect,
+      # causing the delete to fail.
+      #
+      # The solution is to wait a short amount of time before retrying the
+      # removal.
+      #
+      if {$nRetry > 0} {
+        for {set i 0} {$i < $nRetry} {incr i} {
+          set rc [catch {
+            remove_win32_dir $dirName
+          } msg]
+          if {$rc == 0} break
+          if {$nDelay > 0} { after $nDelay }
+        }
+        if {$rc} { error $msg }
+      } else {
+        remove_win32_dir $dirName
+      }
+    }
+  }
+
+  proc do_delete_win32_file {args} {
+    set nRetry [getFileRetries]     ;# Maximum number of retries.
+    set nDelay [getFileRetryDelay]  ;# Delay in ms before retrying.
+
+    foreach fileName $args {
+      # On windows, sometimes even a [delete_win32_file] can fail just after
+      # a file is closed. The cause is usually "tag-alongs" - programs like
+      # anti-virus software, automatic backup tools and various explorer
+      # extensions that keep a file open a little longer than we expect,
+      # causing the delete to fail.
+      #
+      # The solution is to wait a short amount of time before retrying the
+      # delete.
+      #
+      if {$nRetry > 0} {
+        for {set i 0} {$i < $nRetry} {incr i} {
+          set rc [catch {
+            delete_win32_file $fileName
+          } msg]
+          if {$rc == 0} break
+          if {$nDelay > 0} { after $nDelay }
+        }
+        if {$rc} { error $msg }
+      } else {
+        delete_win32_file $fileName
+      }
+    }
+  }
+}
+
 proc execpresql {handle args} {
   trace remove execution $handle enter [list execpresql $handle]
   if {[info exists ::G(perm:presql)]} {
@@ -144,8 +374,8 @@ proc do_not_use_codec {} {
 #
 if {[info exists cmdlinearg]==0} {
 
-  # Parse any options specified in the $argv array. This script accepts the 
-  # following options: 
+  # Parse any options specified in the $argv array. This script accepts the
+  # following options:
   #
   #   --pause
   #   --soft-heap-limit=NN
@@ -154,7 +384,10 @@ if {[info exists cmdlinearg]==0} {
   #   --backtrace=N
   #   --binarylog=N
   #   --soak=N
+  #   --file-retries=N
+  #   --file-retry-delay=N
   #   --start=[$permutation:]$testfile
+  #   --match=$pattern
   #
   set cmdlinearg(soft-heap-limit)    0
   set cmdlinearg(maxerror)        1000
@@ -162,13 +395,16 @@ if {[info exists cmdlinearg]==0} {
   set cmdlinearg(backtrace)         10
   set cmdlinearg(binarylog)          0
   set cmdlinearg(soak)               0
-  set cmdlinearg(start)             "" 
+  set cmdlinearg(file-retries)       0
+  set cmdlinearg(file-retry-delay)   0
+  set cmdlinearg(start)             ""
+  set cmdlinearg(match)             ""
 
   set leftover [list]
   foreach a $argv {
     switch -regexp -- $a {
       {^-+pause$} {
-        # Wait for user input before continuing. This is to give the user an 
+        # Wait for user input before continuing. This is to give the user an
         # opportunity to connect profiling tools to the process.
         puts -nonewline "Press RETURN to begin..."
         flush stdout
@@ -197,6 +433,14 @@ if {[info exists cmdlinearg]==0} {
         foreach {dummy cmdlinearg(soak)} [split $a =] break
         set ::G(issoak) $cmdlinearg(soak)
       }
+      {^-+file-retries=.+$} {
+        foreach {dummy cmdlinearg(file-retries)} [split $a =] break
+        set ::G(file-retries) $cmdlinearg(file-retries)
+      }
+      {^-+file-retry-delay=.+$} {
+        foreach {dummy cmdlinearg(file-retry-delay)} [split $a =] break
+        set ::G(file-retry-delay) $cmdlinearg(file-retry-delay)
+      }
       {^-+start=.+$} {
         foreach {dummy cmdlinearg(start)} [split $a =] break
 
@@ -207,6 +451,12 @@ if {[info exists cmdlinearg]==0} {
         }
         if {$::G(start:file) == ""} {unset ::G(start:file)}
       }
+      {^-+match=.+$} {
+        foreach {dummy cmdlinearg(match)} [split $a =] break
+
+        set ::G(match) $cmdlinearg(match)
+        if {$::G(match) == ""} {unset ::G(match)}
+      }
       default {
         lappend leftover $a
       }
@@ -217,8 +467,8 @@ if {[info exists cmdlinearg]==0} {
   # Install the malloc layer used to inject OOM errors. And the 'automatic'
   # extensions. This only needs to be done once for the process.
   #
-  sqlite3_shutdown 
-  install_malloc_faultsim 1 
+  sqlite3_shutdown
+  install_malloc_faultsim 1
   sqlite3_initialize
   autoinstall_test_functions
 
@@ -246,9 +496,9 @@ sqlite3_soft_heap_limit $cmdlinearg(soft-heap-limit)
 #
 proc reset_db {} {
   catch {db close}
-  file delete -force test.db
-  file delete -force test.db-journal
-  file delete -force test.db-wal
+  forcedelete test.db
+  forcedelete test.db-journal
+  forcedelete test.db-wal
   sqlite3 db ./test.db
   set ::DB [sqlite3_connection_pointer db]
   if {[info exists ::SETUP_SQL]} {
@@ -274,6 +524,7 @@ if {0==[info exists ::SLAVE]} {
   set TC(count)     0
   set TC(fail_list) [list]
   set TC(omit_list) [list]
+  set TC(warn_list) [list]
 
   proc set_test_counter {counter args} {
     if {[llength $args]} {
@@ -285,9 +536,11 @@ if {0==[info exists ::SLAVE]} {
 
 # Record the fact that a sequence of tests were omitted.
 #
-proc omit_test {name reason} {
+proc omit_test {name reason {append 1}} {
   set omitList [set_test_counter omit_list]
-  lappend omitList [list $name $reason]
+  if {$append} {
+    lappend omitList [list $name $reason]
+  }
   set_test_counter omit_list $omitList
 }
 
@@ -306,6 +559,18 @@ proc fail_test {name} {
   }
 }
 
+# Remember a warning message to be displayed at the conclusion of all testing
+#
+proc warning {msg {append 1}} {
+  puts "Warning: $msg"
+  set warnList [set_test_counter warn_list]
+  if {$append} {
+    lappend warnList $msg
+  }
+  set_test_counter warn_list $warnList
+}
+
+
 # Increment the number of tests run
 #
 proc incr_ntest {} {
@@ -313,17 +578,16 @@ proc incr_ntest {} {
 }
 
 
-# Invoke the do_test procedure to run a single test 
+# Invoke the do_test procedure to run a single test
 #
 proc do_test {name cmd expected} {
-
   global argv cmdlinearg
 
   fix_testname name
 
   sqlite3_memdebug_settitle $name
 
-#  if {[llength $argv]==0} { 
+#  if {[llength $argv]==0} {
 #    set go 1
 #  } else {
 #    set go 0
@@ -342,34 +606,122 @@ proc do_test {name cmd expected} {
   incr_ntest
   puts -nonewline $name...
   flush stdout
-  if {[catch {uplevel #0 "$cmd;\n"} result]} {
-    puts "\nError: $result"
-    fail_test $name
-  } elseif {[string compare $result $expected]} {
-    puts "\nExpected: \[$expected\]\n     Got: \[$result\]"
-    fail_test $name
+
+  if {![info exists ::G(match)] || [string match $::G(match) $name]} {
+    if {[catch {uplevel #0 "$cmd;\n"} result]} {
+      puts "\nError: $result"
+      fail_test $name
+    } else {
+      if {[regexp {^~?/.*/$} $expected]} {
+        # "expected" is of the form "/PATTERN/" then the result if correct if
+        # regular expression PATTERN matches the result.  "~/PATTERN/" means
+        # the regular expression must not match.
+        if {[string index $expected 0]=="~"} {
+          set re [string range $expected 2 end-1]
+          if {[string index $re 0]=="*"} {
+            # If the regular expression begins with * then treat it as a glob instead
+            set ok [string match $re $result]
+          } else {
+            set re [string map {# {[-0-9.]+}} $re]
+            set ok [regexp $re $result]
+          }
+          set ok [expr {!$ok}]
+        } else {
+          set re [string range $expected 1 end-1]
+          if {[string index $re 0]=="*"} {
+            # If the regular expression begins with * then treat it as a glob instead
+            set ok [string match $re $result]
+          } else {
+            set re [string map {# {[-0-9.]+}} $re]
+            set ok [regexp $re $result]
+          }
+        }
+      } elseif {[regexp {^~?\*.*\*$} $expected]} {
+        # "expected" is of the form "*GLOB*" then the result if correct if
+        # glob pattern GLOB matches the result.  "~/GLOB/" means
+        # the glob must not match.
+        if {[string index $expected 0]=="~"} {
+          set e [string range $expected 1 end]
+          set ok [expr {![string match $e $result]}]
+        } else {
+          set ok [string match $expected $result]
+        }
+      } else {
+        set ok [expr {[string compare $result $expected]==0}]
+      }
+      if {!$ok} {
+        # if {![info exists ::testprefix] || $::testprefix eq ""} {
+        #   error "no test prefix"
+        # }
+        puts "\nExpected: \[$expected\]\n     Got: \[$result\]"
+        fail_test $name
+      } else {
+        puts " Ok"
+      }
+    }
   } else {
-    puts " Ok"
+    puts " Omitted"
+    omit_test $name "pattern mismatch" 0
   }
   flush stdout
 }
 
+proc catchcmd {db {cmd ""}} {
+  global CLI
+  set out [open cmds.txt w]
+  puts $out $cmd
+  close $out
+  set line "exec $CLI $db < cmds.txt"
+  set rc [catch { eval $line } msg]
+  list $rc $msg
+}
+
+proc filepath_normalize {p} {
+  # test cases should be written to assume "unix"-like file paths
+  if {$::tcl_platform(platform)!="unix"} {
+    # lreverse*2 as a hack to remove any unneeded {} after the string map
+    lreverse [lreverse [string map {\\ /} [regsub -nocase -all {[a-z]:[/\\]+} $p {/}]]]
+  } {
+    set p
+  }
+}
+proc do_filepath_test {name cmd expected} {
+  uplevel [list do_test $name [
+    subst -nocommands { filepath_normalize [ $cmd ] }
+  ] [filepath_normalize $expected]]
+}
+
+proc realnum_normalize {r} {
+  # different TCL versions display floating point values differently.
+  string map {1.#INF inf Inf inf .0e e} [regsub -all {(e[+-])0+} $r {\1}]
+}
+proc do_realnum_test {name cmd expected} {
+  uplevel [list do_test $name [
+    subst -nocommands { realnum_normalize [ $cmd ] }
+  ] [realnum_normalize $expected]]
+}
+
 proc fix_testname {varname} {
   upvar $varname testname
-  if {[info exists ::testprefix] 
+  if {[info exists ::testprefix]
    && [string is digit [string range $testname 0 0]]
   } {
     set testname "${::testprefix}-$testname"
   }
 }
-    
+
 proc do_execsql_test {testname sql {result {}}} {
   fix_testname testname
-  uplevel do_test $testname [list "execsql {$sql}"] [list [list {*}$result]]
+  uplevel do_test [list $testname] [list "execsql {$sql}"] [list [list {*}$result]]
 }
 proc do_catchsql_test {testname sql result} {
   fix_testname testname
-  uplevel do_test $testname [list "catchsql {$sql}"] [list $result]
+  uplevel do_test [list $testname] [list "catchsql {$sql}"] [list $result]
+}
+proc do_timed_execsql_test {testname sql {result {}}} {
+  fix_testname testname
+  uplevel do_test [list $testname] [list "execsql_timed {$sql}"]\
+                                   [list [list {*}$result]]
 }
 proc do_eqp_test {name sql res} {
   uplevel do_execsql_test $name [list "EXPLAIN QUERY PLAN $sql"] [list $res]
@@ -448,7 +800,7 @@ proc delete_all_data {} {
   }
 }
 
-# Run an SQL script.  
+# Run an SQL script.
 # Return the number of microseconds per statement.
 #
 proc speed_trial {name numstmt units sql} {
@@ -511,6 +863,7 @@ proc speed_trial_summary {name} {
 #
 proc finish_test {} {
   catch {db close}
+  catch {db1 close}
   catch {db2 close}
   catch {db3 close}
   if {0==[info exists ::SLAVE]} { finalize_testing }
@@ -534,9 +887,31 @@ proc finalize_testing {} {
   set nTest [incr_ntest]
   set nErr [set_test_counter errors]
 
-  puts "$nErr errors out of $nTest tests"
-  if {$nErr>0} {
-    puts "Failures on these tests: [set_test_counter fail_list]"
+  set nKnown 0
+  if {[file readable known-problems.txt]} {
+    set fd [open known-problems.txt]
+    set content [read $fd]
+    close $fd
+    foreach x $content {set known_error($x) 1}
+    foreach x [set_test_counter fail_list] {
+      if {[info exists known_error($x)]} {incr nKnown}
+    }
+  }
+  if {$nKnown>0} {
+    puts "[expr {$nErr-$nKnown}] new errors and $nKnown known errors\
+         out of $nTest tests"
+  } else {
+    puts "$nErr errors out of $nTest tests"
+  }
+  if {$nErr>$nKnown} {
+    puts -nonewline "Failures on these tests:"
+    foreach x [set_test_counter fail_list] {
+      if {![info exists known_error($x)]} {puts -nonewline " $x"}
+    }
+    puts ""
+  }
+  foreach warning [set_test_counter warn_list] {
+    puts "Warning: $warning"
   }
   run_thread_tests 1
   if {[llength $omitList]>0} {
@@ -597,10 +972,10 @@ proc finalize_testing {} {
     }
   }
   foreach f [glob -nocomplain test.db-*-journal] {
-    file delete -force $f
+    forcedelete $f
   }
   foreach f [glob -nocomplain test.db-mj*] {
-    file delete -force $f
+    forcedelete $f
   }
   exit [expr {$nErr>0}]
 }
@@ -645,6 +1020,14 @@ proc execsql {sql {db db}} {
   # puts "SQL = $sql"
   uplevel [list $db eval $sql]
 }
+proc execsql_timed {sql {db db}} {
+  set tm [time {
+    set x [uplevel [list $db eval $sql]]
+  } 1]
+  set tm [lindex $tm 0]
+  puts -nonewline " ([expr {$tm*0.001}]ms) "
+  set x
+}
 
 # Execute SQL and catch exceptions.
 #
@@ -668,6 +1051,89 @@ proc explain {sql {db db}} {
   }
 }
 
+proc explain_i {sql {db db}} {
+  puts ""
+  puts "addr  opcode        p1      p2      p3      p4                p5  #"
+  puts "----  ------------  ------  ------  ------  ----------------  --  -"
+
+
+  # Set up colors for the different opcodes. Scheme is as follows:
+  #
+  #   Red:   Opcodes that write to a b-tree.
+  #   Blue:  Opcodes that reposition or seek a cursor. 
+  #   Green: The ResultRow opcode.
+  #
+  if { [catch {fconfigure stdout -mode}]==0 } {
+    set R "\033\[31;1m"        ;# Red fg
+    set G "\033\[32;1m"        ;# Green fg
+    set B "\033\[34;1m"        ;# Red fg
+    set D "\033\[39;0m"        ;# Default fg
+  } else {
+    set R ""
+    set G ""
+    set B ""
+    set D ""
+  }
+  foreach opcode {
+      Seek SeekGe SeekGt SeekLe SeekLt NotFound Last Rewind
+      NoConflict Next Prev VNext VPrev VFilter
+      SorterSort SorterNext
+  } {
+    set color($opcode) $B
+  }
+  foreach opcode {ResultRow} {
+    set color($opcode) $G
+  }
+  foreach opcode {IdxInsert Insert Delete IdxDelete} {
+    set color($opcode) $R
+  }
+
+  set bSeenGoto 0
+  $db eval "explain $sql" {} {
+    set x($addr) 0
+    set op($addr) $opcode
+
+    if {$opcode == "Goto" && ($bSeenGoto==0 || ($p2 > $addr+10))} {
+      set linebreak($p2) 1
+      set bSeenGoto 1
+    }
+
+    if {$opcode=="Next"  || $opcode=="Prev" 
+     || $opcode=="VNext" || $opcode=="VPrev"
+     || $opcode=="SorterNext"
+    } {
+      for {set i $p2} {$i<$addr} {incr i} {
+        incr x($i) 2
+      }
+    }
+
+    if {$opcode == "Goto" && $p2<$addr && $op($p2)=="Yield"} {
+      for {set i [expr $p2+1]} {$i<$addr} {incr i} {
+        incr x($i) 2
+      }
+    }
+
+    if {$opcode == "Halt" && $comment == "End of coroutine"} {
+      set linebreak([expr $addr+1]) 1
+    }
+  }
+
+  $db eval "explain $sql" {} {
+    if {[info exists linebreak($addr)]} {
+      puts ""
+    }
+    set I [string repeat " " $x($addr)]
+
+    set col ""
+    catch { set col $color($opcode) }
+
+    puts [format {%-4d  %s%s%-12.12s%s  %-6d  %-6d  %-6d  % -17s %s  %s} \
+      $addr $I $col $opcode $D $p1 $p2 $p3 $p4 $p5 $comment
+    ]
+  }
+  puts "----  ------------  ------  ------  ------  ----------------  --  -"
+}
+
 # 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.
@@ -690,6 +1156,15 @@ proc execsql2 {sql} {
   return $result
 }
 
+# Use a temporary in-memory database to execute SQL statements
+#
+proc memdbsql {sql} {
+  sqlite3 memdb :memory:
+  set result [memdb eval $sql]
+  memdb close
+  return $result
+}
+
 # Use the non-callback API to execute multiple SQL statements
 #
 proc stepsql {dbptr sql} {
@@ -715,30 +1190,6 @@ proc stepsql {dbptr sql} {
   return $r
 }
 
-# Delete a file or directory
-#
-proc forcedelete {args} {
-  foreach filename $args {
-    # On windows, sometimes even a [file delete -force] can fail just after
-    # a file is closed. The cause is usually "tag-alongs" - programs like
-    # anti-virus software, automatic backup tools and various explorer
-    # extensions that keep a file open a little longer than we expect, causing
-    # the delete to fail.
-    #
-    # The solution is to wait a short amount of time before retrying the 
-    # delete.
-    #
-    set nRetry  50                  ;# Maximum number of retries.
-    set nDelay 100                  ;# Delay in ms before retrying.
-    for {set i 0} {$i<$nRetry} {incr i} {
-      set rc [catch {file delete -force $filename} msg]
-      if {$rc==0} break
-      after $nDelay
-    }
-    if {$rc} { error $msg }
-  }
-}
-
 # Do an integrity check of the entire database
 #
 proc integrity_check {name {db db}} {
@@ -747,6 +1198,23 @@ proc integrity_check {name {db db}} {
   }
 }
 
+# Check the extended error code
+#
+proc verify_ex_errcode {name expected {db db}} {
+  do_test $name [list sqlite3_extended_errcode $db] $expected
+}
+
+
+# Return true if the SQL statement passed as the second argument uses a
+# statement transaction.
+#
+proc sql_uses_stmt {db sql} {
+  set stmt [sqlite3_prepare $db $sql -1 dummy]
+  set uses [uses_stmt_journal $stmt]
+  sqlite3_finalize $stmt
+  return $uses
+}
+
 proc fix_ifcapable_expr {expr} {
   set ret ""
   set state 0
@@ -766,6 +1234,12 @@ proc fix_ifcapable_expr {expr} {
   return $ret
 }
 
+# Returns non-zero if the capabilities are present; zero otherwise.
+#
+proc capable {expr} {
+  set e [fix_ifcapable_expr $expr]; return [expr ($e)]
+}
+
 # Evaluate a boolean expression of capabilities.  If true, execute the
 # code.  Omit the code if false.
 #
@@ -792,7 +1266,7 @@ proc ifcapable {expr code {else ""} {elsecode ""}} {
 # 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.
+# occurred.
 #
 #   crashsql -delay CRASHDELAY -file CRASHFILE ?-blocksize BLOCKSIZE? $sql
 #
@@ -801,17 +1275,19 @@ proc crashsql {args} {
   set blocksize ""
   set crashdelay 1
   set prngseed 0
+  set opendb { sqlite3 db test.db -vfs crash }
   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 -opendb]==0}    {set opendb $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}  \
@@ -824,16 +1300,16 @@ proc crashsql {args} {
     error "Compulsory option -file missing"
   }
 
-  # $crashfile gets compared to the native filename in 
+  # $crashfile gets compared to the native filename in
   # cfSync(), which can be different then what TCL uses by
   # default, so here we force it to the "nativename" format.
-  set cfile [string map {\\ \\\\} [file nativename [file join [pwd] $crashfile]]]
+  set cfile [string map {\\ \\\\} [file nativename [file join [get_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"
+  puts $f $opendb 
 
   # This block sets the cache size of the main database to 10
   # pages. This is done in case the build is configured to omit
@@ -841,6 +1317,7 @@ proc crashsql {args} {
   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
@@ -859,7 +1336,7 @@ proc crashsql {args} {
   set r [catch {
     exec [info nameofexec] crash.tcl >@stdout
   } msg]
-  
+
   # Windows/ActiveState TCL returns a slightly different
   # error message.  We map that to the expected message
   # so that we don't have to change all of the test
@@ -869,14 +1346,33 @@ proc crashsql {args} {
       set msg "child process exited abnormally"
     }
   }
-  
+
   lappend r $msg
 }
 
+proc run_ioerr_prep {} {
+  set ::sqlite_io_error_pending 0
+  catch {db close}
+  catch {db2 close}
+  catch {forcedelete test.db}
+  catch {forcedelete test.db-journal}
+  catch {forcedelete test2.db}
+  catch {forcedelete 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
+}
+
 # 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 
+# 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.
@@ -906,14 +1402,30 @@ proc do_ioerr_test {testname args} {
   # a couple of obscure IO errors that do not return them.
   set ::ioerropts(-erc) 0
 
+  # 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)}"
+  }
+
+  save_prng_state
+  if {$::ioerropts(-cksum)} {
+    run_ioerr_prep
+    eval $::ioerrorbody
+    set ::goodcksum [cksum]
+  }
+
   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
@@ -922,30 +1434,15 @@ proc do_ioerr_test {testname args} {
       restore_prng_state
     }
 
-    # Delete the files test.db and test2.db, then execute the TCL and 
+    # 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
+      run_ioerr_prep
     } {0}
 
     # Read the 'checksum' of the database.
     if {$::ioerropts(-cksum)} {
-      set checksum [cksum]
+      set ::checksum [cksum]
     }
 
     # Set the Nth IO error to fail.
@@ -953,20 +1450,10 @@ proc do_ioerr_test {testname args} {
       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.
+    # Execute the TCL script created for the body of this test. If
+    # 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
@@ -1019,12 +1506,12 @@ proc do_ioerr_test {testname args} {
     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, 
+    # 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 
+    # 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].
@@ -1040,7 +1527,7 @@ proc do_ioerr_test {testname args} {
       } {1}
     }
 
-    # If there is an open database handle and no open transaction, 
+    # 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
@@ -1062,7 +1549,7 @@ proc do_ioerr_test {testname args} {
       }
     }
 
-    # If an IO error occured, then the checksum of the database should
+    # If an IO error occurred, 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)} {
@@ -1070,8 +1557,15 @@ proc do_ioerr_test {testname args} {
         catch {db close}
         catch {db2 close}
         set ::DB [sqlite3 db test.db; sqlite3_connection_pointer db]
-        cksum
-      } $checksum
+        set nowcksum [cksum]
+        set res [expr {$nowcksum==$::checksum || $nowcksum==$::goodcksum}]
+        if {$res==0} {
+          puts "now=$nowcksum"
+          puts "the=$::checksum"
+          puts "fwd=$::goodcksum"
+        }
+        set res
+      } 1
     }
 
     set ::sqlite_io_error_hardhit 0
@@ -1137,7 +1631,7 @@ proc allcksum {{db db}} {
 }
 
 # Generate a checksum based on the contents of a single database with
-# a database connection.  The name of the database is $dbname.  
+# a database connection.  The name of the database is $dbname.
 # Examples of $dbname are "temp" or "main".
 #
 proc dbcksum {db dbname} {
@@ -1205,24 +1699,6 @@ proc memdebug_log_sql {{filename mallocs.sql}} {
   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
-  }
-}
-
 # Drop all tables in database [db]
 proc drop_all_tables {{db db}} {
   ifcapable trigger&&foreignkey {
@@ -1249,8 +1725,8 @@ proc drop_all_tables {{db db}} {
 
 #-------------------------------------------------------------------------
 # If a test script is executed with global variable $::G(perm:name) set to
-# "wal", then the tests are run in WAL mode. Otherwise, they should be run 
-# in rollback mode. The following Tcl procs are used to make this less 
+# "wal", then the tests are run in WAL mode. Otherwise, they should be run
+# in rollback mode. The following Tcl procs are used to make this less
 # intrusive:
 #
 #   wal_set_journal_mode ?DB?
@@ -1265,9 +1741,9 @@ proc drop_all_tables {{db db}} {
 #     Otherwise (if not running a WAL permutation) this is a no-op.
 #
 #   wal_is_wal_mode
-#   
+#
 #     Returns true if this test should be run in WAL mode. False otherwise.
-# 
+#
 proc wal_is_wal_mode {} {
   expr {[permutation] eq "wal"}
 }
@@ -1368,10 +1844,10 @@ proc slave_test_file {zFile} {
   }
   set ::sqlite_open_file_count 0
 
-  # Test that the global "shared-cache" setting was not altered by 
+  # Test that the global "shared-cache" setting was not altered by
   # the test script.
   #
-  ifcapable shared_cache { 
+  ifcapable shared_cache {
     set res [expr {[sqlite3_enable_shared_cache] == $scs}]
     do_test ${tail}-sharedcachesetting [list set {} $res] 1
   }
@@ -1404,7 +1880,7 @@ proc db_save {} {
   foreach f [glob -nocomplain sv_test.db*] { forcedelete $f }
   foreach f [glob -nocomplain test.db*] {
     set f2 "sv_$f"
-    file copy -force $f $f2
+    forcecopy $f $f2
   }
 }
 proc db_save_and_close {} {
@@ -1416,7 +1892,7 @@ proc db_restore {} {
   foreach f [glob -nocomplain test.db*] { forcedelete $f }
   foreach f2 [glob -nocomplain sv_test.db*] {
     set f [string range $f2 3 end]
-    file copy -force $f2 $f
+    forcecopy $f2 $f
   }
 }
 proc db_restore_and_reopen {{dbfile test.db}} {
@@ -1426,7 +1902,7 @@ proc db_restore_and_reopen {{dbfile test.db}} {
 }
 proc db_delete_and_reopen {{file test.db}} {
   catch { db close }
-  foreach f [glob -nocomplain test.db*] { file delete -force $f }
+  foreach f [glob -nocomplain test.db*] { forcedelete $f }
   sqlite3 db $file
 }
 
@@ -1434,5 +1910,14 @@ proc db_delete_and_reopen {{file test.db}} {
 # to non-zero, then set the global variable $AUTOVACUUM to 1.
 set AUTOVACUUM $sqlite_options(default_autovacuum)
 
+# Make sure the FTS enhanced query syntax is disabled.
+set sqlite_fts3_enable_parentheses 0
+
+# During testing, assume that all database files are well-formed.  The
+# few test cases that deliberately corrupt database files should rescind 
+# this setting by invoking "database_can_be_corrupt"
+#
+database_never_corrupt
+
 source $testdir/thread_common.tcl
 source $testdir/malloc_common.tcl