Import SQLite 3.10.2.

third_party/sqlite/src/test/tester.tcl

 # 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.
 #
 #***********************************************************************
@@ skipping 63 matching lines @@
 #
 # Commands to help create test files that run with the "WAL" and other
 # permutations (see file permutations.test):
 #
 #      wal_is_wal_mode
 #      wal_set_journal_mode   ?DB?
 #      wal_check_journal_mode TESTNAME?DB?
 #      permutation
 #      presql
 #
+# Command to test whether or not --verbose=1 was specified on the command
+# line (returns 0 for not-verbose, 1 for verbose and 2 for "verbose in the
+# output file only").
+#
+#      verbose
+#
 
 # 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
 # very large database files.
 #
 set tcl_precision 15
 sqlite3_test_control_pending_byte 0x0010000
 
@@ skipping 287 matching lines @@
   #   --soft-heap-limit=NN
   #   --maxerror=NN
   #   --malloctrace=N
   #   --backtrace=N
   #   --binarylog=N
   #   --soak=N
   #   --file-retries=N
   #   --file-retry-delay=N
   #   --start=[$permutation:]$testfile
   #   --match=$pattern
+  #   --verbose=$val
+  #   --output=$filename
+  #   --help
   #
   set cmdlinearg(soft-heap-limit)    0
   set cmdlinearg(maxerror)        1000
   set cmdlinearg(malloctrace)        0
   set cmdlinearg(backtrace)         10
   set cmdlinearg(binarylog)          0
   set cmdlinearg(soak)               0
   set cmdlinearg(file-retries)       0
   set cmdlinearg(file-retry-delay)   0
   set cmdlinearg(start)             ""
   set cmdlinearg(match)             ""
+  set cmdlinearg(verbose)           ""
+  set cmdlinearg(output)            ""
 
   set leftover [list]
   foreach a $argv {
     switch -regexp -- $a {
       {^-+pause$} {
         # 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
         gets stdin
@@ skipping 38 matching lines @@
           set ::G(start:file)        ${s.file}
         }
         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)}
       }
+
+      {^-+output=.+$} {
+        foreach {dummy cmdlinearg(output)} [split $a =] break
+        if {$cmdlinearg(verbose)==""} {
+          set cmdlinearg(verbose) 2
+        }
+      }
+      {^-+verbose=.+$} {
+        foreach {dummy cmdlinearg(verbose)} [split $a =] break
+        if {$cmdlinearg(verbose)=="file"} {
+          set cmdlinearg(verbose) 2
+        } elseif {[string is boolean -strict $cmdlinearg(verbose)]==0} {
+          error "option --verbose= must be set to a boolean or to \"file\""
+        }
+      }
+
       default {
         lappend leftover $a
       }
     }
   }
   set argv $leftover
 
   # 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_initialize
   autoinstall_test_functions
 
   # If the --binarylog option was specified, create the logging VFS. This
   # call installs the new VFS as the default for all SQLite connections.
   #
   if {$cmdlinearg(binarylog)} {
     vfslog new binarylog {} vfslog.bin
   }
 
   # Set the backtrace depth, if malloc tracing is enabled.
   #
   if {$cmdlinearg(malloctrace)} {
     sqlite3_memdebug_backtrace $cmdlinearg(backtrace)
   }
+
+  if {$cmdlinearg(output)!=""} {
+    puts "Copying output to file $cmdlinearg(output)"
+    set ::G(output_fd) [open $cmdlinearg(output) w]
+    fconfigure $::G(output_fd) -buffering line
+  }
+
+  if {$cmdlinearg(verbose)==""} {
+    set cmdlinearg(verbose) 1
+  }
 }
 
 # 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.
 #
 sqlite3_soft_heap_limit $cmdlinearg(soft-heap-limit)
 
 # Create a test database
 #
@@ skipping 50 matching lines @@
 # Record the fact that a test failed.
 #
 proc fail_test {name} {
   set f [set_test_counter fail_list]
   lappend f $name
   set_test_counter fail_list $f
   set_test_counter errors [expr [set_test_counter errors] + 1]
 
   set nFail [set_test_counter errors]
   if {$nFail>=$::cmdlinearg(maxerror)} {
-    puts "*** Giving up..."
+    output2 "*** Giving up..."
     finalize_testing
   }
 }
 
 # Remember a warning message to be displayed at the conclusion of all testing
 #
 proc warning {msg {append 1}} {
-  puts "Warning: $msg"
+  output2 "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 {} {
   set_test_counter count [expr [set_test_counter count] + 1]
 }
 
+# Return true if --verbose=1 was specified on the command line. Otherwise,
+# return false.
+#
+proc verbose {} {
+  return $::cmdlinearg(verbose)
+}
+
+# Use the following commands instead of [puts] for test output within
+# this file. Test scripts can still use regular [puts], which is directed
+# to stdout and, if one is open, the --output file.
+#
+# output1: output that should be printed if --verbose=1 was specified.
+# output2: output that should be printed unconditionally.
+# output2_if_no_verbose: output that should be printed only if --verbose=0.
+#
+proc output1 {args} {
+  set v [verbose]
+  if {$v==1} {
+    uplevel output2 $args
+  } elseif {$v==2} {
+    uplevel puts [lrange $args 0 end-1] $::G(output_fd) [lrange $args end end]
+  }
+}
+proc output2 {args} {
+  set nArg [llength $args]
+  uplevel puts $args
+}
+proc output2_if_no_verbose {args} {
+  set v [verbose]
+  if {$v==0} {
+    uplevel output2 $args
+  } elseif {$v==2} {
+    uplevel puts [lrange $args 0 end-1] stdout [lrange $args end end]
+  }
+}
+
+# Override the [puts] command so that if no channel is explicitly 
+# specified the string is written to both stdout and to the file 
+# specified by "--output=", if any.
+#
+proc puts_override {args} {
+  set nArg [llength $args]
+  if {$nArg==1 || ($nArg==2 && [string first [lindex $args 0] -nonewline]==0)} {
+    uplevel puts_original $args
+    if {[info exists ::G(output_fd)]} {
+      uplevel puts [lrange $args 0 end-1] $::G(output_fd) [lrange $args end end]
+    }
+  } else {
+    # A channel was explicitly specified.
+    uplevel puts_original $args
+  }
+}
+rename puts puts_original
+proc puts {args} { uplevel puts_override $args }
+
 
 # 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} {
 #    set go 1
 #  } else {
 #    set go 0
 #    foreach pattern $argv {
 #      if {[string match $pattern $name]} {
 #        set go 1
 #        break
 #      }
 #    }
 #  }
 
   if {[info exists ::G(perm:prefix)]} {
     set name "$::G(perm:prefix)$name"
   }
 
   incr_ntest
-  puts -nonewline $name...
+  output1 -nonewline $name...
   flush stdout
 
   if {![info exists ::G(match)] || [string match $::G(match) $name]} {
     if {[catch {uplevel #0 "$cmd;\n"} result]} {
-      puts "\nError: $result"
+      output2_if_no_verbose -nonewline $name...
+      output2 "\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
@@ skipping 23 matching lines @@
         } 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\]"
+        output1 ""
+        output2 "! $name expected: \[$expected\]\n! $name got:      \[$result\]"
         fail_test $name
       } else {
-        puts " Ok"
+        output1 " Ok"
       }
     }
   } else {
-    puts " Omitted"
+    output1 " Omitted"
     omit_test $name "pattern mismatch" 0
   }
   flush stdout
 }
 
+proc dumpbytes {s} {
+  set r ""
+  for {set i 0} {$i < [string length $s]} {incr i} {
+    if {$i > 0} {append r " "}
+    append r [format %02X [scan [string index $s $i] %c]]
+  }
+  return $r
+}
+
 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 catchcmdex {db {cmd ""}} {
+  global CLI
+  set out [open cmds.txt w]
+  fconfigure $out -encoding binary -translation binary
+  puts -nonewline $out $cmd
+  close $out
+  set line "exec -keepnewline -- $CLI $db < cmds.txt"
+  set chans [list stdin stdout stderr]
+  foreach chan $chans {
+    catch {
+      set modes($chan) [fconfigure $chan]
+      fconfigure $chan -encoding binary -translation binary -buffering none
+    }
+  }
+  set rc [catch { eval $line } msg]
+  foreach chan $chans {
+    catch {
+      eval fconfigure [list $chan] $modes($chan)
+    }
+  }
+  # puts [dumpbytes $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} {
@@ skipping 108 matching lines @@
 proc delete_all_data {} {
   db eval {SELECT tbl_name AS t FROM sqlite_master WHERE type = 'table'} {
     db eval "DELETE FROM '[string map {' ''} $t]'"
   }
 }
 
 # Run an SQL script.
 # Return the number of microseconds per statement.
 #
 proc speed_trial {name numstmt units sql} {
-  puts -nonewline [format {%-21.21s } $name...]
+  output2 -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]
+  output2 [format {%12d uS %s %s} $tm $rate $u2]
   global total_time
   set total_time [expr {$total_time+$tm}]
   lappend ::speed_trial_times $name $tm
 }
 proc speed_trial_tcl {name numstmt units script} {
-  puts -nonewline [format {%-21.21s } $name...]
+  output2 -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]
+  output2 [format {%12d uS %s %s} $tm $rate $u2]
   global total_time
   set total_time [expr {$total_time+$tm}]
   lappend ::speed_trial_times $name $tm
 }
 proc speed_trial_init {name} {
   global total_time
   set total_time 0
   set ::speed_trial_times [list]
   sqlite3 versdb :memory:
   set vers [versdb one {SELECT sqlite_source_id()}]
   versdb close
-  puts "SQLite $vers"
+  output2 "SQLite $vers"
 }
 proc speed_trial_summary {name} {
   global total_time
-  puts [format {%-21.21s %12d uS TOTAL} $name $total_time]
+  output2 [format {%-21.21s %12d uS TOTAL} $name $total_time]
 
   if { 0 } {
     sqlite3 versdb :memory:
     set vers [lindex [versdb one {SELECT sqlite_source_id()}] 0]
     versdb close
-    puts "CREATE TABLE IF NOT EXISTS time(version, script, test, us);"
+    output2 "CREATE TABLE IF NOT EXISTS time(version, script, test, us);"
     foreach {test us} $::speed_trial_times {
-      puts "INSERT INTO time VALUES('$vers', '$name', '$test', $us);"
+      output2 "INSERT INTO time VALUES('$vers', '$name', '$test', $us);"
     }
   }
 }
 
 # Run this routine last
 #
 proc finish_test {} {
   catch {db close}
   catch {db1 close}
   catch {db2 close}
@@ skipping 23 matching lines @@
   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\
+    output2 "[expr {$nErr-$nKnown}] new errors and $nKnown known errors\
          out of $nTest tests"
   } else {
-    puts "$nErr errors out of $nTest tests"
+    output2 "$nErr errors out of $nTest tests"
   }
   if {$nErr>$nKnown} {
-    puts -nonewline "Failures on these tests:"
+    output2 -nonewline "!Failures on these tests:"
     foreach x [set_test_counter fail_list] {
-      if {![info exists known_error($x)]} {puts -nonewline " $x"}
+      if {![info exists known_error($x)]} {output2 -nonewline " $x"}
     }
-    puts ""
+    output2 ""
   }
   foreach warning [set_test_counter warn_list] {
-    puts "Warning: $warning"
+    output2 "Warning: $warning"
   }
   run_thread_tests 1
   if {[llength $omitList]>0} {
-    puts "Omitted test cases:"
+    output2 "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]]
+      output2 [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 "******************************************************************"
+    output2 "******************************************************************"
+    output2 "N.B.:  The version of TCL that you used to build this test harness"
+    output2 "is defective in that it does not support 64-bit integers.  Some or"
+    output2 "all of the test failures above might be a result from this defect"
+    output2 "in your TCL build."
+    output2 "******************************************************************"
   }
   if {$::cmdlinearg(binarylog)} {
     vfslog finalize binarylog
   }
   if {$sqlite_open_file_count} {
-    puts "$sqlite_open_file_count files were left open"
+    output2 "$sqlite_open_file_count files were left open"
     incr nErr
   }
   if {[lindex [sqlite3_status SQLITE_STATUS_MALLOC_COUNT 0] 1]>0 ||
               [sqlite3_memory_used]>0} {
-    puts "Unfreed memory: [sqlite3_memory_used] bytes in\
+    output2 "Unfreed memory: [sqlite3_memory_used] bytes in\
          [lindex [sqlite3_status SQLITE_STATUS_MALLOC_COUNT 0] 1] allocations"
     incr nErr
     ifcapable memdebug||mem5||(mem3&&debug) {
-      puts "Writing unfreed memory log to \"./memleak.txt\""
+      output2 "Writing unfreed memory log to \"./memleak.txt\""
       sqlite3_memdebug_dump ./memleak.txt
     }
   } else {
-    puts "All memory allocations freed - no leaks"
+    output2 "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"
+  output2 "Maximum memory usage: [sqlite3_memory_highwater 1] bytes"
+  output2 "Current memory usage: [sqlite3_memory_highwater] bytes"
   if {[info commands sqlite3_memdebug_malloc_count] ne ""} {
-    puts "Number of malloc()  : [sqlite3_memdebug_malloc_count] calls"
+    output2 "Number of malloc()  : [sqlite3_memdebug_malloc_count] calls"
   }
   if {$::cmdlinearg(malloctrace)} {
-    puts "Writing mallocs.sql..."
+    output2 "Writing mallocs.sql..."
     memdebug_log_sql
     sqlite3_memdebug_log stop
     sqlite3_memdebug_log clear
 
     if {[sqlite3_memory_used]>0} {
-      puts "Writing leaks.sql..."
+      output2 "Writing leaks.sql..."
       sqlite3_memdebug_log sync
       memdebug_log_sql leaks.sql
     }
   }
   foreach f [glob -nocomplain test.db-*-journal] {
     forcedelete $f
   }
   foreach f [glob -nocomplain test.db-mj*] {
     forcedelete $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"
+  output1 "Memory used:          $val"
   set x [sqlite3_status SQLITE_STATUS_MALLOC_COUNT 0]
   set val [format {now %10d  max %10d} [lindex $x 1] [lindex $x 2]]
-  puts "Allocation count:     $val"
+  output1 "Allocation count:     $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"
+  output1 "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"
+  output1 "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"
+  output1 "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"
+  output1 "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"
+    output2 "Parser stack depth:    $val"
   }
 }
 
 # A procedure to execute SQL
 #
 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) "
+  output1 -nonewline " ([expr {$tm*0.001}]ms) "
   set x
 }
 
 # Execute SQL and catch exceptions.
 #
 proc catchsql {sql {db db}} {
   # puts "SQL = $sql"
   set r [catch [list uplevel [list $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 "----  ------------  ------  ------  ------  ---------------  --  -"
+  output2 ""
+  output2 "addr  opcode        p1      p2      p3      p4               p5  #"
+  output2 "----  ------------  ------  ------  ------  ---------------  --  -"
   $db eval "explain $sql" {} {
-    puts [format {%-4d  %-12.12s  %-6d  %-6d  %-6d  % -17s %s  %s} \
+    output2 [format {%-4d  %-12.12s  %-6d  %-6d  %-6d  % -17s %s  %s} \
       $addr $opcode $p1 $p2 $p3 $p4 $p5 $comment
     ]
   }
 }
 
 proc explain_i {sql {db db}} {
-  puts ""
-  puts "addr  opcode        p1      p2      p3      p4                p5  #"
-  puts "----  ------------  ------  ------  ------  ----------------  --  -"
+  output2 ""
+  output2 "addr  opcode        p1      p2      p3      p4                p5  #"
+  output2 "----  ------------  ------  ------  ------  ----------------  --  -"
 
 
   # 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
@@ skipping 45 matching lines @@
       }
     }
 
     if {$opcode == "Halt" && $comment == "End of coroutine"} {
       set linebreak([expr $addr+1]) 1
     }
   }
 
   $db eval "explain $sql" {} {
     if {[info exists linebreak($addr)]} {
-      puts ""
+      output2 ""
     }
     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} \
+    output2 [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 "----  ------------  ------  ------  ------  ----------------  --  -"
+  output2 "----  ------------  ------  ------  ------  ----------------  --  -"
 }
 
 # 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]
 }
@@ skipping 157 matching lines @@
 
   # $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 [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 $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
   # "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 {$opendb!=""} {
+    puts $f $opendb 
+    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
   }
@@ skipping 223 matching lines @@
     # 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]
         set nowcksum [cksum]
         set res [expr {$nowcksum==$::checksum || $nowcksum==$::goodcksum}]
         if {$res==0} {
-          puts "now=$nowcksum"
-          puts "the=$::checksum"
-          puts "fwd=$::goodcksum"
+          output2 "now=$nowcksum"
+          output2 "the=$::checksum"
+          output2 "fwd=$::goodcksum"
         }
         set res
       } 1
     }
 
     set ::sqlite_io_error_hardhit 0
     set ::sqlite_io_error_pending 0
     if {[info exists ::ioerropts(-cleanup)]} {
       catch $::ioerropts(-cleanup)
     }
@@ skipping 203 matching lines @@
 
   # Populate some global variables that tester.tcl expects to see.
   foreach {var value} [list              \
     ::argv0 $::argv0                     \
     ::argv  {}                           \
     ::SLAVE 1                            \
   ] {
     interp eval tinterp [list set $var $value]
   }
 
+  # If output is being copied into a file, share the file-descriptor with
+  # the interpreter.
+  if {[info exists ::G(output_fd)]} {
+    interp share {} $::G(output_fd) tinterp
+  }
+
   # The alias used to access the global test counters.
   tinterp alias set_test_counter set_test_counter
 
   # Set up the ::cmdlinearg array in the slave.
   interp eval tinterp [list array set ::cmdlinearg [array get ::cmdlinearg]]
 
   # Set up the ::G array in the slave.
   interp eval tinterp [list array set ::G [array get ::G]]
 
   # Load the various test interfaces implemented in C.
@@ skipping 48 matching lines @@
   # Test that the global "shared-cache" setting was not altered by
   # the test script.
   #
   ifcapable shared_cache {
     set res [expr {[sqlite3_enable_shared_cache] == $scs}]
     do_test ${tail}-sharedcachesetting [list set {} $res] 1
   }
 
   # Add some info to the output.
   #
-  puts "Time: $tail $ms ms"
+  output2 "Time: $tail $ms ms"
   show_memstats
 }
 
 # Open a new connection on database test.db and execute the SQL script
 # supplied as an argument. Before returning, close the new conection and
 # restore the 4 byte fields starting at header offsets 28, 92 and 96
 # to the values they held before the SQL was executed. This simulates
 # a write by a pre-3.7.0 client.
 #
 proc sql36231 {sql} {
@@ skipping 31 matching lines @@
   catch { db close }
   db_restore
   sqlite3 db $dbfile
 }
 proc db_delete_and_reopen {{file test.db}} {
   catch { db close }
   foreach f [glob -nocomplain test.db*] { forcedelete $f }
   sqlite3 db $file
 }
 
+# Close any connections named [db], [db2] or [db3]. Then use sqlite3_config
+# to configure the size of the PAGECACHE allocation using the parameters
+# provided to this command. Save the old PAGECACHE parameters in a global 
+# variable so that [test_restore_config_pagecache] can restore the previous
+# configuration.
+#
+# Before returning, reopen connection [db] on file test.db.
+#
+proc test_set_config_pagecache {sz nPg} {
+  catch {db close}
+  catch {db2 close}
+  catch {db3 close}
+
+  sqlite3_shutdown
+  set ::old_pagecache_config [sqlite3_config_pagecache $sz $nPg]
+  sqlite3_initialize
+  autoinstall_test_functions
+  reset_db
+}
+
+# Close any connections named [db], [db2] or [db3]. Then use sqlite3_config
+# to configure the size of the PAGECACHE allocation to the size saved in
+# the global variable by an earlier call to [test_set_config_pagecache].
+#
+# Before returning, reopen connection [db] on file test.db.
+#
+proc test_restore_config_pagecache {} {
+  catch {db close}
+  catch {db2 close}
+  catch {db3 close}
+
+  sqlite3_shutdown
+  eval sqlite3_config_pagecache $::old_pagecache_config
+  unset ::old_pagecache_config 
+  sqlite3_initialize
+  autoinstall_test_functions
+  sqlite3 db test.db
+}
+
 # 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)
 
 # 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