Add the --output=$file and --verbose=(0|1|file) options to tester.tcl.

FossilOrigin-Name: f7b2c70362f10ee0347c1d2318918ffefa53243d

manifest

@@ -1,5 +1,5 @@
-C Add\sthe\svalgrindfuzz\starget\sto\sunix\smakefile.
+C Add\sthe\s--output=$file\sand\s--verbose=(0|1|file)\soptions\sto\stester.tcl.
-D 2015-06-08T19:15:50.266
+D 2015-06-09T15:58:28.618
 F Makefile.arm-wince-mingw32ce-gcc d6df77f1f48d690bd73162294bbba7f59507c72f
 F Makefile.in 580e006530fab67ccd34926ce2eda66d326af60f
 F Makefile.linux-gcc 91d710bdc4998cb015f39edf3cb314ec4f4d7e23
@@ -949,7 +949,7 @@ F test/tclsqlite.test 7fb866443c7deceed22b63948ccd6f76b52ad054
 F test/tempdb.test 19d0f66e2e3eeffd68661a11c83ba5e6ace9128c
 F test/temptable.test d2c9b87a54147161bcd1822e30c1d1cd891e5b30
 F test/temptrigger.test 8ec228b0db5d7ebc4ee9b458fc28cb9e7873f5e1
-F test/tester.tcl c18dbf42f4b0c1fb889b0efeb8a59d5143dd9828
+F test/tester.tcl ca396a3f867c1bd3603400ca8f17bbffd87985b7
 F test/thread001.test 9f22fd3525a307ff42a326b6bc7b0465be1745a5
 F test/thread002.test e630504f8a06c00bf8bbe68528774dd96aeb2e58
 F test/thread003.test ee4c9efc3b86a6a2767516a37bd64251272560a7
@@ -1285,7 +1285,7 @@ F tool/vdbe_profile.tcl 67746953071a9f8f2f668b73fe899074e2c6d8c1
 F tool/warnings-clang.sh f6aa929dc20ef1f856af04a730772f59283631d4
 F tool/warnings.sh 0abfd78ceb09b7f7c27c688c8e3fe93268a13b32
 F tool/win/sqlite.vsix deb315d026cc8400325c5863eef847784a219a2f
-P e49c291735e613e384f6da044ef865dd274cabc8
+P e62aed01f1a6dbc12d6e21386c1671eb640b8d49
-R 038506d4cfda1e2a7849e18cec45efaf
+R f55cc3f41ca69cff9ff874d367e120de
-U drh
+U dan
-Z dac87b83585efac2cb7ce09058568bbf
+Z 528ec808c863ae4b55820f5f3962de4a

manifest.uuid

@@ -1 +1 @@
-e62aed01f1a6dbc12d6e21386c1671eb640b8d49
+f7b2c70362f10ee0347c1d2318918ffefa53243d

test/tester.tcl

@@ -81,6 +81,12 @@
 #      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
@@ -388,6 +394,9 @@ if {[info exists cmdlinearg]==0} {
   #   --file-retry-delay=N
   #   --start=[$permutation:]$testfile
   #   --match=$pattern
+  #   --verbose=$val
+  #   --output=$filename
+  #   --help
   #
   set cmdlinearg(soft-heap-limit)    0
   set cmdlinearg(maxerror)        1000
@@ -399,6 +408,8 @@ if {[info exists cmdlinearg]==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 {
@@ -457,6 +468,22 @@ if {[info exists cmdlinearg]==0} {
         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
       }
@@ -484,6 +511,16 @@ if {[info exists cmdlinearg]==0} {
   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
@@ -554,7 +591,7 @@ proc fail_test {name} {
 
   set nFail [set_test_counter errors]
   if {$nFail>=$::cmdlinearg(maxerror)} {
-    puts "*** Giving up..."
+    output2 "*** Giving up..."
     finalize_testing
   }
 }
@@ -562,7 +599,7 @@ 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"
+  output2 "Warning: $msg"
   set warnList [set_test_counter warn_list]
   if {$append} {
     lappend warnList $msg
@@ -577,6 +614,61 @@ 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
 #
@@ -604,12 +696,13 @@ proc do_test {name cmd expected} {
   }
 
   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]} {
@@ -653,14 +746,15 @@ proc do_test {name cmd expected} {
         # if {![info exists ::testprefix] || $::testprefix eq ""} {
         #   error "no test prefix"
         # }
-        puts "\nExpected: \[$expected\]\n     Got: \[$result\]"
+        output2_if_no_verbose -nonewline $name...
+        output2 "\nExpected: \[$expected\]\n     Got: \[$result\]"
         fail_test $name
       } else {
-        puts " Ok"
+        output1 " Ok"
       }
     }
   } else {
-    puts " Omitted"
+    output1 " Omitted"
     omit_test $name "pattern mismatch" 0
   }
   flush stdout
@@ -837,7 +931,7 @@ proc delete_all_data {} {
 # 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]
@@ -847,13 +941,13 @@ proc speed_trial {name numstmt units sql} {
     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]
@@ -863,7 +957,7 @@ proc speed_trial_tcl {name numstmt units script} {
     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
@@ -875,19 +969,19 @@ proc speed_trial_init {name} {
   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);"
     }
   }
 }
@@ -931,75 +1025,75 @@ proc finalize_testing {} {
     }
   }
   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 "******************************************************************"
+    output2 "******************************************************************"
-    puts "N.B.:  The version of TCL that you used to build this test harness"
+    output2 "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"
+    output2 "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"
+    output2 "all of the test failures above might be a result from this defect"
-    puts "in your TCL build."
+    output2 "in your TCL build."
-    puts "******************************************************************"
+    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"
+  output2 "Maximum memory usage: [sqlite3_memory_highwater 1] bytes"
-  puts "Current memory usage: [sqlite3_memory_highwater] 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
     }
@@ -1020,30 +1114,30 @@ proc show_memstats {} {
   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"
   }
 }
 
@@ -1058,7 +1152,7 @@ proc execsql_timed {sql {db db}} {
     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
 }
 
@@ -1595,9 +1689,9 @@ proc do_ioerr_test {testname args} {
         set nowcksum [cksum]
         set res [expr {$nowcksum==$::checksum || $nowcksum==$::goodcksum}]
         if {$res==0} {
-          puts "now=$nowcksum"
+          output2 "now=$nowcksum"
-          puts "the=$::checksum"
+          output2 "the=$::checksum"
-          puts "fwd=$::goodcksum"
+          output2 "fwd=$::goodcksum"
         }
         set res
       } 1
@@ -1821,6 +1915,12 @@ proc slave_test_script {script} {
     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
 
@@ -1889,7 +1989,7 @@ proc slave_test_file {zFile} {
 
   # Add some info to the output.
   #
-  puts "Time: $tail $ms ms"
+  output2 "Time: $tail $ms ms"
   show_memstats
 }