Bring the ancient malloc3.test file closer into relevance with the latest core code.

FossilOrigin-Name: 9793a21c13a1188383b4be64df86629f196ca330

diff --git a/manifest b/manifest
index 9ecf488892b7501113a15671104e78730fa3c7cd..a79aea4367ba16340054597775e297a648753b1f 100644 (file)
--- a/manifest
+++ b/manifest
@@ -1,5 +1,5 @@
-C Stop\susing\sthe\sTCL_LIBS\sconfiguration\svariable\swhen\slinking\swith\sTcl.\nRemove\ssuperfluous\s'rm'\scommand\sfrom\sthe\s"clean"\starget.
-D 2012-12-06T02:56:05.083
+C Bring\sthe\sancient\smalloc3.test\sfile\scloser\sinto\srelevance\swith\sthe\slatest\score\scode.
+D 2012-12-06T04:19:24.854
 F Makefile.arm-wince-mingw32ce-gcc d6df77f1f48d690bd73162294bbba7f59507c72f
 F Makefile.in 690d441a758cbffd13e814dc2724a721a6ebd400
 F Makefile.linux-gcc 91d710bdc4998cb015f39edf3cb314ec4f4d7e23
@@ -587,7 +587,7 @@ F test/lookaside.test 93f07bac140c5bb1d49f3892d2684decafdc7af2
 F test/main.test 39c4bb8a157f57298ed1659d6df89d9f35aaf2c8
 F test/make-where7.tcl 05c16b5d4f5d6512881dfec560cb793915932ef9
 F test/malloc.test bc745155ff4252d4f35ec8316625b0dfe2abc659
-F test/malloc3.test de8eca0c3e748878845fdca3663ec4b642073caf
+F test/malloc3.test c4f172a3007d90750f2cf0232f24a3e8d80197bd
 F test/malloc4.test 957337613002b7058a85116493a262f679f3a261
 F test/malloc5.test a577cbbcc1594c7763b9b3515b3633555751c7f0
 F test/malloc6.test 2f039d9821927eacae43e1831f815e157659a151
@@ -1025,7 +1025,7 @@ F tool/vdbe-compress.tcl f12c884766bd14277f4fcedcae07078011717381
 F tool/warnings-clang.sh f6aa929dc20ef1f856af04a730772f59283631d4
 F tool/warnings.sh fbc018d67fd7395f440c28f33ef0f94420226381
 F tool/win/sqlite.vsix 97894c2790eda7b5bce3cc79cb2a8ec2fde9b3ac
-P 7b6951016f5bf4c21f843f09769ba176c709e785 e1feab9834fe829d43ae895cc575ad269a36668c
-R f01b3a94b8eaef4b696e4f8ea4977242
-U drh
-Z 32493e27d940243c2fe11a6697bb936e
+P 1551277208048cb24887928f2f971e47a942c849
+R 2cd100741db07187aa3e11b20913cc45
+U mistachkin
+Z 3201c1cb9479ff298b2a89dab4136397

diff --git a/manifest.uuid b/manifest.uuid
index f4c64a7549bbc25d5594343f3b3e185071770e13..57be4707f777a00c6f1d7ae1cdcf35fc95e49e9b 100644 (file)
--- a/manifest.uuid
+++ b/manifest.uuid
@@ -1 +1 @@
-1551277208048cb24887928f2f971e47a942c849
\ No newline at end of file
+9793a21c13a1188383b4be64df86629f196ca330
\ No newline at end of file

diff --git a/test/malloc3.test b/test/malloc3.test
index 2dfde466a0b34b4dcc84e9e2c31c0a6277c8314b..46d5c0b6c9531f7216172d112bce999b569a921a 100644 (file)
--- a/test/malloc3.test
+++ b/test/malloc3.test
@@ -147,6 +147,7 @@ if {!$MEMDEBUG} {
 # ::run_test_script. At the end of this file, the proc [run_test] is used
 # to execute the program (and all test cases contained therein).
 #
+set ::run_test_sql_id 0
 set ::run_test_script [list]
 proc TEST {id t} {lappend ::run_test_script -test [list $id $t]}
 proc PREP {p} {lappend ::run_test_script -prep [string trim $p]}
@@ -162,13 +163,14 @@ proc DEBUG {s} {lappend ::run_test_script -debug $s}
 # transaction only.
 #
 proc SQL  {a1 {a2 ""}} {
-  # An SQL primitive parameter is a list of two elements, a boolean value
-  # indicating if the statement may cause transaction rollback when malloc()
-  # fails, and the sql statement itself.
+  # An SQL primitive parameter is a list of three elements, an id, a boolean
+  # value indicating if the statement may cause transaction rollback when
+  # malloc() fails, and the sql statement itself.
+  set id [incr ::run_test_sql_id]
   if {$a2 == ""} {
-    lappend ::run_test_script -sql [list true [string trim $a1]]
+    lappend ::run_test_script -sql [list $id true [string trim $a1]]
   } else {
-    lappend ::run_test_script -sql [list false [string trim $a2]]
+    lappend ::run_test_script -sql [list $id false [string trim $a2]]
   }
 }
 
@@ -258,7 +260,7 @@ TEST 5 {
 set sql {
   BEGIN;DELETE FROM abc;
 }
-for {set i 1} {$i < 15} {incr i} {
+for {set i 1} {$i < 100} {incr i} {
   set a $i
   set b "String value $i"
   set c [string repeat X $i]
@@ -529,12 +531,13 @@ proc run_test {arglist iRepeat {pcstart 0} {iFailStart 1}} {
   }
 
   for {set i 0} {$i < $pcstart} {incr i} {
-    set k2 [lindex $arglist [expr 2 * $i]]
-    set v2 [lindex $arglist [expr 2 * $i + 1]]
+    set k2 [lindex $arglist [expr {2 * $i}]]
+    set v2 [lindex $arglist [expr {2 * $i + 1}]]
     set ac [sqlite3_get_autocommit $::DB]        ;# Auto-Commit
     switch -- $k2 {
-      -sql  {db eval [lindex $v2 1]}
+      -sql  {db eval [lindex $v2 2]}
       -prep {db eval $v2}
+      -debug {eval $v2}
     }
     set nac [sqlite3_get_autocommit $::DB]       ;# New Auto-Commit 
     if {$ac && !$nac} {set begin_pc $i}
@@ -545,25 +548,31 @@ proc run_test {arglist iRepeat {pcstart 0} {iFailStart 1}} {
   set iFail $iFailStart
   set pc $pcstart
   while {$pc*2 < [llength $arglist]} {
+    # Fetch the current instruction type and payload.
+    set k [lindex $arglist [expr {2 * $pc}]]
+    set v [lindex $arglist [expr {2 * $pc + 1}]]
 
     # Id of this iteration:
-    set k [lindex $arglist [expr 2 * $pc]]
     set iterid "pc=$pc.iFail=$iFail$k"
-    set v [lindex $arglist [expr 2 * $pc + 1]]
 
     switch -- $k {
 
       -test { 
         foreach {id script} $v {}
+        set testid "malloc3-(test $id).$iterid"
+        eval $script
         incr pc
       }
 
       -sql {
         set ::rollback_hook_count 0
 
+        set id [lindex $v 0]
+        set testid "malloc3-(integrity $id).$iterid"
+
         set ac [sqlite3_get_autocommit $::DB]        ;# Auto-Commit
         sqlite3_memdebug_fail $iFail -repeat 0
-        set rc [catch {db eval [lindex $v 1]} msg]   ;# True error occurs
+        set rc [catch {db eval [lindex $v 2]} msg]   ;# True error occurs
         set nac [sqlite3_get_autocommit $::DB]       ;# New Auto-Commit 
 
         if {$rc != 0 && $nac && !$ac} {
@@ -571,7 +580,7 @@ proc run_test {arglist iRepeat {pcstart 0} {iFailStart 1}} {
           # is set. Since an error occured we assume this was not a
           # commit - therefore a rollback occured. Check that the
           # rollback-hook was invoked.
-          do_test malloc3-rollback_hook.$iterid {
+          do_test malloc3-rollback_hook_count.$iterid {
             set ::rollback_hook_count
           } {1}
         }
@@ -582,8 +591,9 @@ proc run_test {arglist iRepeat {pcstart 0} {iFailStart 1}} {
             # calls should be equal to the number of benign failures.
             # Otherwise a malloc() failed and the error was not reported.
             # 
-            if {$nFail!=$nBenign} {
-              error "Unreported malloc() failure"
+            set expr {$nFail!=$nBenign}
+            if {[expr $expr]} {
+              error "Unreported malloc() failure, test \"$testid\", $expr"
             }
 
             if {$ac && !$nac} {
@@ -595,24 +605,23 @@ proc run_test {arglist iRepeat {pcstart 0} {iFailStart 1}} {
 
             incr pc
             set iFail 1
-            integrity_check "malloc3-(integrity).$iterid"
+            integrity_check $testid
         } elseif {[regexp {.*out of memory} $msg] || [db errorcode] == 3082} {
             # Out of memory error, as expected.
             #
-            integrity_check "malloc3-(integrity).$iterid"
+            integrity_check $testid
             incr iFail
             if {$nac && !$ac} {
-
-              if {![lindex $v 0] && [db errorcode] != 3082} {
-                # error "Statement \"[lindex $v 1]\" caused a rollback"
+              if {![lindex $v 1] && [db errorcode] != 3082} {
+                # error "Statement \"[lindex $v 2]\" caused a rollback"
               }
 
               for {set i $begin_pc} {$i < $pc} {incr i} {
-                set k2 [lindex $arglist [expr 2 * $i]]
-                set v2 [lindex $arglist [expr 2 * $i + 1]]
+                set k2 [lindex $arglist [expr {2 * $i}]]
+                set v2 [lindex $arglist [expr {2 * $i + 1}]]
                 set catchupsql ""
                 switch -- $k2 {
-                  -sql  {set catchupsql [lindex $v2 1]}
+                  -sql  {set catchupsql [lindex $v2 2]}
                   -prep {set catchupsql $v2}
                 }
                 db eval $catchupsql
@@ -622,7 +631,8 @@ proc run_test {arglist iRepeat {pcstart 0} {iFailStart 1}} {
             error $msg
         }
 
-        while {[lindex $arglist [expr 2 * ($pc -1)]] == "-test"} {
+        # back up to the previous "-test" block.
+        while {[lindex $arglist [expr {2 * ($pc - 1)}]] == "-test"} {
           incr pc -1
         }
       }
@@ -642,7 +652,7 @@ proc run_test {arglist iRepeat {pcstart 0} {iFailStart 1}} {
   }
 }
 
-# Turn of the Tcl interface's prepared statement caching facility. Then
+# Turn off the Tcl interface's prepared statement caching facility. Then
 # run the tests with "persistent" malloc failures.
 sqlite3_extended_result_codes db 1
 db cache size 0