Import SQLite 3.10.2.

third_party/sqlite/src/test/malloc_common.tcl

 # 2007 May 05
 #
 # 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 111 matching lines @@
   global FAULTSIM
   
   foreach n [array names FAULTSIM] {
     if {$n != "interrupt"} {lappend DEFAULT(-faults) $n}
   }
   set DEFAULT(-prep)          ""
   set DEFAULT(-body)          ""
   set DEFAULT(-test)          ""
   set DEFAULT(-install)       ""
   set DEFAULT(-uninstall)     ""
+  set DEFAULT(-start)          1
+  set DEFAULT(-end)            0
 
   fix_testname name
 
   array set O [array get DEFAULT]
   array set O $args
   foreach o [array names O] {
     if {[info exists DEFAULT($o)]==0} { error "unknown option: $o" }
   }
 
   set faultlist [list]
   foreach f $O(-faults) {
     set flist [array names FAULTSIM $f]
     if {[llength $flist]==0} { error "unknown fault: $f" }
     set faultlist [concat $faultlist $flist]
   }
 
   set testspec [list -prep $O(-prep) -body $O(-body) \
-      -test $O(-test) -install $O(-install) -uninstall $O(-uninstall)
+      -test $O(-test) -install $O(-install) -uninstall $O(-uninstall) \
+      -start $O(-start) -end $O(-end)
   ]
   foreach f [lsort -unique $faultlist] {
     eval do_one_faultsim_test "$name-$f" $FAULTSIM($f) $testspec
   }
 }
 
 
 #-------------------------------------------------------------------------
 # Procedures to save and restore the current file-system state:
 #
@@ skipping 122 matching lines @@
 }
 
 # This command is not called directly. It is used by the 
 # [faultsim_test_result] command created by [do_faultsim_test] and used
 # by -test scripts.
 #
 proc faultsim_test_result_int {args} {
   upvar testrc testrc testresult testresult testnfail testnfail
   set t [list $testrc $testresult]
   set r $args
-  if { ($testnfail==0 && $t != [lindex $r 0]) || [lsearch $r $t]<0 } {
+  if { ($testnfail==0 && $t != [lindex $r 0]) || [lsearch -exact $r $t]<0 } {
     error "nfail=$testnfail rc=$testrc result=$testresult list=$r"
   }
 }
 
 #--------------------------------------------------------------------------
 # Usage do_one_faultsim_test NAME ?OPTIONS...? 
 #
 # The first argument, <test number>, is used as a prefix of the test names
 # taken by tests executed by this command. Options are as follows. All
 # options take a single argument.
 #
 #     -injectstart      Script to enable fault-injection.
 #
 #     -injectstop       Script to disable fault-injection.
 #
 #     -injecterrlist    List of generally acceptable test results (i.e. error
 #                       messages). Example: [list {1 {out of memory}}]
 #
 #     -injectinstall
 #
 #     -injectuninstall
 #
 #     -prep             Script to execute before -body.
 #
 #     -body             Script to execute (with fault injection).
 #
 #     -test             Script to execute after -body.
 #
+#     -start            Index of first fault to inject (default 1)
+#
 proc do_one_faultsim_test {testname args} {
 
   set DEFAULT(-injectstart)     "expr"
   set DEFAULT(-injectstop)      "expr 0"
   set DEFAULT(-injecterrlist)   [list]
   set DEFAULT(-injectinstall)   ""
   set DEFAULT(-injectuninstall) ""
   set DEFAULT(-prep)            ""
   set DEFAULT(-body)            ""
   set DEFAULT(-test)            ""
   set DEFAULT(-install)         ""
   set DEFAULT(-uninstall)       ""
+  set DEFAULT(-start)           1
+  set DEFAULT(-end)             0
 
   array set O [array get DEFAULT]
   array set O $args
   foreach o [array names O] {
     if {[info exists DEFAULT($o)]==0} { error "unknown option: $o" }
   }
 
   proc faultsim_test_proc {testrc testresult testnfail} $O(-test)
   proc faultsim_test_result {args} "
     uplevel faultsim_test_result_int \$args [list $O(-injecterrlist)]
   "
 
   eval $O(-injectinstall)
   eval $O(-install)
 
   set stop 0
-  for {set iFail 1} {!$stop} {incr iFail} {
+  for {set iFail $O(-start)}                        \
+      {!$stop && ($O(-end)==0 || $iFail<=$O(-end))} \
+      {incr iFail}                                  \
+  {
 
     # Evaluate the -prep script.
     #
     eval $O(-prep)
 
     # Start the fault-injection. Run the -body script. Stop the fault
     # injection. Local var $nfail is set to the total number of faults 
     # injected into the system this trial.
     #
     eval $O(-injectstart) $iFail
@@ skipping 318 matching lines @@
         if {[lsearch $answers $res]>=0} {
           set res $str
         }
         do_test $name.$zName.$iFail [list set {} $res] $str
         set cksum2 [db one $cksumsql]
         if {$cksum1 != $cksum2} return
       }
     }
   }
 }