Better integrate the new malloc related instrumentation with the test infrastructure. (CVS 4904)

FossilOrigin-Name: d2140cae39dcced63e3ad5771e52d522ce587c96

manifest

@@ -1,5 +1,5 @@
-C Make\ssure\sthe\stext\sresult\sof\san\saggregate\sfunction\shas\sthe\scorrect\nencoding.\s\sTicket\s#3009.\s(CVS\s4903)
-D 2008-03-21T17:13:13
+C Better\sintegrate\sthe\snew\smalloc\srelated\sinstrumentation\swith\sthe\stest\sinfrastructure.\s(CVS\s4904)
+D 2008-03-21T17:29:38
 F Makefile.arm-wince-mingw32ce-gcc ac5f7b2cef0cd850d6f755ba6ee4ab961b1fadf7
 F Makefile.in cf434ce8ca902e69126ae0f94fc9f7dc7428a5fa
 F Makefile.linux-gcc d53183f4aa6a9192d249731c90dbdffbd2c68654
@@ -459,7 +459,7 @@ F test/table.test 13b1c2e2fb4727b35ee1fb7641fc469214fd2455
 F test/tableapi.test 791f7e3891d9b70bdb43b311694bf5e9befcbc34
 F test/tclsqlite.test 3fac87cb1059c46b8fa8a60b553f4f1adb0fb6d9
 F test/temptable.test 19b851b9e3e64d91e9867619b2a3f5fffee6e125
-F test/tester.tcl 482f1b003f937249d3b3d6cc9aacd540c9b50635
+F test/tester.tcl 7e6e28cf813e132b84336cdd33804c1be2a1bc80
 F test/thread001.test 8fbd9559da0bbdc273e00318c7fd66c162020af7
 F test/thread002.test 2c4ad2c386f60f6fe268cd91c769ee35b3c1fd0b
 F test/thread1.test 776c9e459b75ba905193b351926ac4019b049f35
@@ -624,7 +624,7 @@ F www/tclsqlite.tcl 8be95ee6dba05eabcd27a9d91331c803f2ce2130
 F www/vdbe.tcl 87a31ace769f20d3627a64fa1fade7fed47b90d0
 F www/version3.tcl 890248cf7b70e60c383b0e84d77d5132b3ead42b
 F www/whentouse.tcl fc46eae081251c3c181bd79c5faef8195d7991a5
-P 2498d3ea36ecab6d9c0f04ef1c49d76a7a215a4f
-R 717f664aa004ee99c89cb098a0645aa5
-U drh
-Z 3c56c09bf585f991755dd8086487319b
+P 13e388cecf53d680a79ef29ff4e82e59de8f1264
+R d19f383f47ede81e505eee11623adac3
+U danielk1977
+Z 449e46ae1e15059fa7102c110d9acde5

manifest.uuid

@@ -1 +1 @@
-13e388cecf53d680a79ef29ff4e82e59de8f1264
+d2140cae39dcced63e3ad5771e52d522ce587c96

test/tester.tcl

@@ -11,7 +11,7 @@
 # This file implements some common TCL routines used for regression
 # testing the SQLite library
 #
-# $Id: tester.tcl,v 1.108 2008/03/21 14:22:44 danielk1977 Exp $
+# $Id: tester.tcl,v 1.109 2008/03/21 17:29:38 danielk1977 Exp $
 
 
 set tcl_precision 15
@@ -44,6 +44,15 @@ sqlite3_soft_heap_limit $soft_limit
 # See the sqlite3_memdebug_backtrace() function in mem2.c or
 # test_malloc.c for additional information.
 #
+for {set i 0} {$i<[llength $argv]} {incr i} {
+  if {[lindex $argv $i] eq "--malloctrace"} {
+    set argv [lreplace $argv $i $i]
+    sqlite3_memdebug_backtrace 5
+    sqlite3_memdebug_log start
+    set argv [lreplace $argv $i $i]
+    set tester_do_malloctrace 1
+  }
+}
 for {set i 0} {$i<[llength $argv]} {incr i} {
   if {[regexp {^--backtrace=(\d+)$} [lindex $argv $i] all value]} {
     sqlite3_memdebug_backtrace $value
@@ -231,6 +240,12 @@ proc finalize_testing {} {
   if {[info commands sqlite3_memdebug_malloc_count] ne ""} {
     puts "Number of malloc()  : [sqlite3_memdebug_malloc_count] calls"
   }
+  if {[info exists ::tester_do_malloctrace]} {
+    puts "Writing mallocs.sql..."
+    memdebug_log_sql
+    sqlite3_memdebug_log stop
+    sqlite3_memdebug_log clear
+  }
   foreach f [glob -nocomplain test.db-*-journal] {
     file delete -force $f
   }
@@ -646,12 +661,14 @@ proc allcksum {{db db}} {
   return [md5 $txt]
 }
 
-proc memdebug_log_sql {database} {
+proc memdebug_log_sql {{filename mallocs.sql}} {
+
   set data [sqlite3_memdebug_log dump]
   set nFrame [expr [llength [lindex $data 0]]-2]
-
   if {$nFrame < 0} { return "" }
 
+  set database temp
+
   set tbl "CREATE TABLE ${database}.malloc(nCall, nByte"
   for {set ii 1} {$ii <= $nFrame} {incr ii} {
     append tbl ", f${ii}"
@@ -667,68 +684,32 @@ proc memdebug_log_sql {database} {
   }
 
   set tbl2 "CREATE TABLE ${database}.frame(frame INTEGER PRIMARY KEY, line);\n"
+  set tbl3 "CREATE TABLE ${database}.file(name PRIMARY KEY, content);\n"
 
   foreach f [array names frames] {
     set addr [format %x $f]
     set cmd "addr2line -e [info nameofexec] $addr"
     set line [eval exec $cmd]
     append sql "INSERT INTO ${database}.frame VALUES($f, '$line');\n"
+
+    set file [lindex [split $line :] 0]
+    set files($file) 1
   }
 
-  return "BEGIN; ${tbl}${tbl2}${sql} ; COMMIT;"
-}
-proc memdebug_log_pp2 {db iLevel iParentFrame iDepth} {
-  set extra 1
-  if {$iParentFrame != 0} {
-    set extra "f[expr $iLevel-1] = $iParentFrame"
-  }
-  set leader [string repeat "         " [expr $iLevel -1]]
-  $db eval "
-    select 
-      sum(ncall) calls, 
-      sum(nbyte) as bytes, 
-      frame,
-      line FROM malloc, 
-      frame WHERE f${iLevel}=frame AND $extra
-      GROUP BY f${iLevel} ORDER BY calls DESC
-  " {
-    puts [format "%s%-10s %10s %s" $leader $calls $bytes $line]
-    if {$iLevel < $iDepth} {
-      memdebug_log_pp2 $db [expr $iLevel + 1] $frame $iDepth
+  foreach f [array names files] {
+    set contents ""
+    catch {
+      set fd [open $f]
+      set contents [read $fd]
+      close $fd
     }
+    set contents [string map {' ''} $contents]
+    append sql "INSERT INTO ${database}.file VALUES('$f', '$contents');\n"
   }
-}
-proc memdebug_log_strip {db} {
-  set nFrame [expr [llength [$db eval "SELECT * FROM malloc LIMIT 1"]] - 2]
 
-  set update "UPDATE malloc SET "
-  for {set ii 1} {$ii <= $nFrame} {incr ii} {
-    if {$ii == $nFrame} {
-      append update "f${ii} = 0"
-    } else {
-      append update "f${ii} = f[expr $ii+1], "
-    }
-  }
-  append update "
-    WHERE 
-      (SELECT line FROM frame WHERE frame = f1) LIKE '%malloc.c:%' OR
-      (SELECT line FROM frame WHERE frame = f1) LIKE '%mem2.c:%'
-  "
-
-  $db eval $update
-  $db eval $update
-  $db eval $update
-}
-proc memdebug_log_pp {{iDepth 1}} {
-  set sql [memdebug_log_sql main]
-  if {$sql eq ""} return
-
-  sqlite3 mddb :memory:
-  mddb eval $sql
-  memdebug_log_strip mddb
-
-  memdebug_log_pp2 mddb 1 0 $iDepth
-  mddb close
+  set fd [open $filename w]
+  puts $fd "BEGIN; ${tbl}${tbl2}${tbl3}${sql} ; COMMIT;"
+  close $fd
 }
 
 # Copy file $from into $to. This is used because some versions of