/ Check-in [de2e3cbd]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Enhance tester.tcl so that when "--malloctrace=1" is specified, the test generates self-contained Tcl scripts that present GUIs instead of *.sql files that require a separate program to interpret.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256:de2e3cbd08c00d235106c040fa472ec267ef8f1ec13c34ed7d16deac8d50b6cc
User & Date: dan 2018-09-18 17:00:06
Context
2018-09-18
17:50
Avoid incrementing the SQLITE_LOOKASIDE_MISS_SIZE stat before sqlite3_open() returns. Fix test script problem in lookaside.test. check-in: e461cb28 user: dan tags: trunk
17:00
Enhance tester.tcl so that when "--malloctrace=1" is specified, the test generates self-contained Tcl scripts that present GUIs instead of *.sql files that require a separate program to interpret. check-in: de2e3cbd user: dan tags: trunk
16:06
Minor improvements to the permutations.test script. Most notably, a command like "permutations.test alter%" now runs all test scripts with names that match the LIKE pattern "alter%". Or, say, "permutations wal alter%" to run all alter% tests in wal mode. check-in: 3e1a2f66 user: dan tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/test_config.c.

120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
  Tcl_SetVar2(interp, "sqlite_options", "mmap", "0", TCL_GLOBAL_ONLY);
#endif

  Tcl_SetVar2(interp, "sqlite_options", "worker_threads", 
      STRINGVALUE(SQLITE_MAX_WORKER_THREADS), TCL_GLOBAL_ONLY
  );

#if 1 /* def SQLITE_MEMDEBUG */
  Tcl_SetVar2(interp, "sqlite_options", "memdebug", "1", TCL_GLOBAL_ONLY);
#else
  Tcl_SetVar2(interp, "sqlite_options", "memdebug", "0", TCL_GLOBAL_ONLY);
#endif

#ifdef SQLITE_ENABLE_8_3_NAMES
  Tcl_SetVar2(interp, "sqlite_options", "8_3_names", "1", TCL_GLOBAL_ONLY);







|







120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
  Tcl_SetVar2(interp, "sqlite_options", "mmap", "0", TCL_GLOBAL_ONLY);
#endif

  Tcl_SetVar2(interp, "sqlite_options", "worker_threads", 
      STRINGVALUE(SQLITE_MAX_WORKER_THREADS), TCL_GLOBAL_ONLY
  );

#ifdef SQLITE_MEMDEBUG 
  Tcl_SetVar2(interp, "sqlite_options", "memdebug", "1", TCL_GLOBAL_ONLY);
#else
  Tcl_SetVar2(interp, "sqlite_options", "memdebug", "0", TCL_GLOBAL_ONLY);
#endif

#ifdef SQLITE_ENABLE_8_3_NAMES
  Tcl_SetVar2(interp, "sqlite_options", "8_3_names", "1", TCL_GLOBAL_ONLY);

Changes to test/altermalloc.test.

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
# $Id: altermalloc.test,v 1.10 2008/10/30 17:21:13 danielk1977 Exp $
#

set testdir [file dirname $argv0]
source $testdir/tester.tcl

# If SQLITE_OMIT_ALTERTABLE is defined, omit this file.
ifcapable !altertable||!memdebug {
  finish_test
  return
}

source $testdir/malloc_common.tcl

do_malloc_test altermalloc-1 -tclprep {







|







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
# $Id: altermalloc.test,v 1.10 2008/10/30 17:21:13 danielk1977 Exp $
#

set testdir [file dirname $argv0]
source $testdir/tester.tcl

# If SQLITE_OMIT_ALTERTABLE is defined, omit this file.
ifcapable !altertable {
  finish_test
  return
}

source $testdir/malloc_common.tcl

do_malloc_test altermalloc-1 -tclprep {

Changes to test/attachmalloc.test.

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#
# $Id: attachmalloc.test,v 1.10 2008/10/22 10:45:38 danielk1977 Exp $
#

set testdir [file dirname $argv0]
source $testdir/tester.tcl

ifcapable !memdebug||!attach {
  finish_test
  return
}

source $testdir/malloc_common.tcl

do_malloc_test attachmalloc-1 -tclprep {







|







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#
# $Id: attachmalloc.test,v 1.10 2008/10/22 10:45:38 danielk1977 Exp $
#

set testdir [file dirname $argv0]
source $testdir/tester.tcl

ifcapable !attach {
  finish_test
  return
}

source $testdir/malloc_common.tcl

do_malloc_test attachmalloc-1 -tclprep {

Changes to test/capi3.test.

807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
...
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
foreach {code english} $code2english {
  do_test capi3-9.$test_number "sqlite3_test_errstr $code" $english
  incr test_number
}

# Test the error message when a "real" out of memory occurs.
if { [permutation] != "nofaultsim" } {
ifcapable memdebug {
  do_test capi3-10-1 {
    sqlite3 db test.db
    set DB [sqlite3_connection_pointer db]
    sqlite3_memdebug_fail 1
    catchsql {
      select * from sqlite_master;
    }
................................................................................
  ifcapable {utf16} {
    do_test capi3-10-6 {
      utf8 [sqlite3_errmsg16 $::DB]
    } {out of memory}
  }
  db close
  sqlite3_memdebug_fail -1
}
}

# The following tests - capi3-11.* - test that a COMMIT or ROLLBACK
# statement issued while there are still outstanding VMs that are part of
# the transaction fails.
sqlite3 db test.db
set DB [sqlite3_connection_pointer db]







<







 







<







807
808
809
810
811
812
813

814
815
816
817
818
819
820
...
843
844
845
846
847
848
849

850
851
852
853
854
855
856
foreach {code english} $code2english {
  do_test capi3-9.$test_number "sqlite3_test_errstr $code" $english
  incr test_number
}

# Test the error message when a "real" out of memory occurs.
if { [permutation] != "nofaultsim" } {

  do_test capi3-10-1 {
    sqlite3 db test.db
    set DB [sqlite3_connection_pointer db]
    sqlite3_memdebug_fail 1
    catchsql {
      select * from sqlite_master;
    }
................................................................................
  ifcapable {utf16} {
    do_test capi3-10-6 {
      utf8 [sqlite3_errmsg16 $::DB]
    } {out of memory}
  }
  db close
  sqlite3_memdebug_fail -1

}

# The following tests - capi3-11.* - test that a COMMIT or ROLLBACK
# statement issued while there are still outstanding VMs that are part of
# the transaction fails.
sqlite3 db test.db
set DB [sqlite3_connection_pointer db]

Changes to test/capi3c.test.

753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
...
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
foreach {code english} $code2english {
  do_test capi3c-9.$test_number "sqlite3_test_errstr $code" $english
  incr test_number
}

# Test the error message when a "real" out of memory occurs.
if { [permutation] != "nofaultsim" } {
ifcapable memdebug {
  do_test capi3c-10-1 {
    sqlite3 db test.db
    set DB [sqlite3_connection_pointer db]
    sqlite3_memdebug_fail 0
    catchsql {
      select * from sqlite_master;
    }
................................................................................
  ifcapable {utf16} {
    do_test capi3c-10-3 {
      utf8 [sqlite3_errmsg16 $::DB]
    } {out of memory}
  }
  db close
  sqlite3_memdebug_fail -1
}
}

# The following tests - capi3c-11.* - test that a COMMIT or ROLLBACK
# statement issued while there are still outstanding VMs that are part of
# the transaction fails.
sqlite3 db test.db
set DB [sqlite3_connection_pointer db]







<







 







<







753
754
755
756
757
758
759

760
761
762
763
764
765
766
...
771
772
773
774
775
776
777

778
779
780
781
782
783
784
foreach {code english} $code2english {
  do_test capi3c-9.$test_number "sqlite3_test_errstr $code" $english
  incr test_number
}

# Test the error message when a "real" out of memory occurs.
if { [permutation] != "nofaultsim" } {

  do_test capi3c-10-1 {
    sqlite3 db test.db
    set DB [sqlite3_connection_pointer db]
    sqlite3_memdebug_fail 0
    catchsql {
      select * from sqlite_master;
    }
................................................................................
  ifcapable {utf16} {
    do_test capi3c-10-3 {
      utf8 [sqlite3_errmsg16 $::DB]
    } {out of memory}
  }
  db close
  sqlite3_memdebug_fail -1

}

# The following tests - capi3c-11.* - test that a COMMIT or ROLLBACK
# statement issued while there are still outstanding VMs that are part of
# the transaction fails.
sqlite3 db test.db
set DB [sqlite3_connection_pointer db]

Changes to test/crash5.test.

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
# $Id: crash5.test,v 1.3 2008/07/12 14:52:20 drh Exp $

set testdir [file dirname $argv0]
source $testdir/tester.tcl

# Only run these tests if memory debugging is turned on.
#
ifcapable !memdebug||!crashtest||!memorymanage {
   puts "Skipping crash5 tests: not compiled with -DSQLITE_MEMDEBUG..."
   finish_test
   return
}

db close








|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
# $Id: crash5.test,v 1.3 2008/07/12 14:52:20 drh Exp $

set testdir [file dirname $argv0]
source $testdir/tester.tcl

# Only run these tests if memory debugging is turned on.
#
ifcapable !crashtest||!memorymanage {
   puts "Skipping crash5 tests: not compiled with -DSQLITE_MEMDEBUG..."
   finish_test
   return
}

db close

Changes to test/fuzz_malloc.test.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
# This file tests malloc failures in concert with fuzzy SQL generation.
#
# $Id: fuzz_malloc.test,v 1.10 2008/08/20 16:35:10 drh Exp $

set testdir [file dirname $argv0]
source $testdir/tester.tcl

ifcapable !memdebug {
  finish_test
  return
}

source $testdir/malloc_common.tcl
source $testdir/fuzz_common.tcl

if {[info exists G(isquick)]} {
  set ::REPEATS 20
} elseif {[info exists G(issoak)]} {
  set ::REPEATS 100







<
<
<
<
<







13
14
15
16
17
18
19





20
21
22
23
24
25
26
# This file tests malloc failures in concert with fuzzy SQL generation.
#
# $Id: fuzz_malloc.test,v 1.10 2008/08/20 16:35:10 drh Exp $

set testdir [file dirname $argv0]
source $testdir/tester.tcl






source $testdir/malloc_common.tcl
source $testdir/fuzz_common.tcl

if {[info exists G(isquick)]} {
  set ::REPEATS 20
} elseif {[info exists G(issoak)]} {
  set ::REPEATS 100

Changes to test/incrblob_err.test.

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
# $Id: incrblob_err.test,v 1.14 2008/07/18 17:16:27 drh Exp $
#

set testdir [file dirname $argv0]
source $testdir/tester.tcl
set ::testprefix incrblob_err

ifcapable {!incrblob  || !memdebug || !tclvar} {
  finish_test
  return
}

source $testdir/malloc_common.tcl

unset -nocomplain ::fd ::data







|







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
# $Id: incrblob_err.test,v 1.14 2008/07/18 17:16:27 drh Exp $
#

set testdir [file dirname $argv0]
source $testdir/tester.tcl
set ::testprefix incrblob_err

ifcapable {!incrblob  || !tclvar} {
  finish_test
  return
}

source $testdir/malloc_common.tcl

unset -nocomplain ::fd ::data

Added test/malloctraceviewer.tcl.



























































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253

package require sqlite3
package require Tk

#############################################################################
# Code to set up scrollbars for widgets. This is generic, boring stuff.
#
namespace eval autoscroll {
  proc scrollable {widget path args} {
    ::ttk::frame $path
    set w  [$widget ${path}.widget {*}$args]
    set vs [::ttk::scrollbar ${path}.vs]
    set hs [::ttk::scrollbar ${path}.hs -orient horizontal]
    grid $w  -row 0 -column 0 -sticky nsew
  
    grid rowconfigure    $path 0 -weight 1
    grid columnconfigure $path 0 -weight 1
  
    set grid [list grid $vs -row 0 -column 1 -sticky nsew]
    $w configure -yscrollcommand [list ::autoscroll::scrollcommand $grid $vs]
    $vs configure -command       [list $w yview]
    set grid [list grid $hs -row 1 -column 0 -sticky nsew]
    $w configure -xscrollcommand [list ::autoscroll::scrollcommand $grid $hs]
    $hs configure -command       [list $w xview]
  
    return $w
  }
  proc scrollcommand {grid sb args} {
    $sb set {*}$args
    set isRequired [expr {[lindex $args 0] != 0.0 || [lindex $args 1] != 1.0}]
    if {$isRequired && ![winfo ismapped $sb]} {
      {*}$grid
    }
    if {!$isRequired && [winfo ismapped $sb]} {
      grid forget $sb
    }
  }
  namespace export scrollable
}
namespace import ::autoscroll::*
#############################################################################

proc populate_text_widget {db} {
  $::O(text) configure -state normal
  set id [lindex [$::O(tree) selection] 0]
  set frame [lindex $id end]

  set line [$db one {SELECT line FROM frame WHERE frame = $frame}]
  if {$line ne ""} {
    foreach {file line} [split $line :] {}
    set content [$db one "SELECT content FROM file WHERE name = '$file'"]
    $::O(text) delete 0.0 end

    set iLine 1
    foreach L [split $content "\n"] {
      if {$iLine == $line} {
        $::O(text) insert end "$L\n" highlight
      } else {
        $::O(text) insert end "$L\n"
      }
      incr iLine
    }
    $::O(text) yview -pickplace ${line}.0
  }
  $::O(text) configure -state disabled
}

proc populate_index {db} {
  $::O(text) configure -state normal
  
  $::O(text) delete 0.0 end
  $::O(text) insert end "\n\n"

  set L [format "    % -40s%12s%12s\n" "Test Case" "Allocations" "Bytes"]
  $::O(text) insert end $L
  $::O(text) insert end "    [string repeat - 64]\n"

  $db eval {
    SELECT 'TOTAL' AS ztest, sum(ncall) AS calls, sum(nbyte) AS bytes
    FROM malloc 
      UNION ALL
    SELECT ztest AS ztest, sum(ncall) AS calls, sum(nbyte) AS bytes
    FROM malloc 
    GROUP BY ztest

    ORDER BY 3 DESC
  } {
    set tags [list $ztest]
    if {$ztest eq $::O(current)} {
      lappend tags highlight
    }
    set L [format "    % -40s%12s%12s\n" $ztest $calls $bytes]
    $::O(text) insert end $L $tags

    $::O(text) tag bind $ztest <1> [list populate_tree_widget $db $ztest]
    $::O(text) tag bind $ztest <Enter> [list $::O(text) configure -cursor hand2]
    $::O(text) tag bind $ztest <Leave> [list $::O(text) configure -cursor ""]
  }

  $::O(text) configure -state disabled
}

proc sort_tree_compare {iLeft iRight} {
  global O
  switch -- [expr (int($O(tree_sort)/2))] {
    0 {
      set left  [$O(tree) item $iLeft -text]
      set right [$O(tree) item $iRight -text]
      set res [string compare $left $right]
    }
    1 {
      set left  [lindex [$O(tree) item $iLeft -values] 0]
      set right [lindex [$O(tree) item $iRight -values] 0]
      set res [expr $left - $right]
    }
    2 {
      set left  [lindex [$O(tree) item $iLeft -values] 1]
      set right [lindex [$O(tree) item $iRight -values] 1]
      set res [expr $left - $right]
    }
  }
  if {$O(tree_sort)&0x01} {
    set res [expr -1 * $res]
  }
  return $res
}

proc sort_tree {iMode} {
  global O
  if {$O(tree_sort) == $iMode} {
    incr O(tree_sort)
  } else {
    set O(tree_sort) $iMode
  }
  set T $O(tree)
  set items [$T children {}]
  set items [lsort -command sort_tree_compare $items]
  for {set ii 0} {$ii < [llength $items]} {incr ii} {
    $T move [lindex $items $ii] {} $ii
  }
}

proc trim_frames {stack} {
  while {[info exists ::O(ignore.[lindex $stack 0])]} {
    set stack [lrange $stack 1 end]
  }
  return $stack
}

proc populate_tree_widget {db zTest} {
  $::O(tree) delete [$::O(tree) children {}]

  for {set ii 0} {$ii < 15} {incr ii} {
    $db eval {
      SELECT 
        sum(ncall) AS calls, 
        sum(nbyte) AS bytes,
        trim_frames(lrange(lstack, 0, $ii)) AS stack
      FROM malloc
      WHERE (zTest = $zTest OR $zTest = 'TOTAL') AND llength(lstack)>$ii
      GROUP BY stack
      HAVING stack != ''
    } {
      set parent_id [lrange $stack 0 end-1]
      set frame [lindex $stack end]
      set line [$db one {SELECT line FROM frame WHERE frame = $frame}]
      set line [lindex [split $line /] end]
      set v [list $calls $bytes]

      catch {
        $::O(tree) insert $parent_id end -id $stack -text $line -values $v
      }
    }
  }

  set ::O(current) $zTest
  populate_index $db
}



set O(tree_sort) 0

::ttk::panedwindow .pan -orient horizontal
set O(tree) [scrollable ::ttk::treeview .pan.tree]

frame .pan.right
set O(text) [scrollable text .pan.right.text]
button .pan.right.index -command {populate_index mddb} -text "Show Index"
pack .pan.right.index -side top -fill x
pack .pan.right.text -fill both -expand true

$O(text) tag configure highlight -background wheat
$O(text) configure -wrap none -height 35

.pan add .pan.tree
.pan add .pan.right

$O(tree) configure     -columns {calls bytes}
$O(tree) heading #0    -text Line  -anchor w -command {sort_tree 0}
$O(tree) heading calls -text Calls -anchor w -command {sort_tree 2}
$O(tree) heading bytes -text Bytes -anchor w -command {sort_tree 4}
$O(tree) column #0    -width 150
$O(tree) column calls -width 100
$O(tree) column bytes -width 100

pack .pan -fill both -expand 1

#--------------------------------------------------------------------
# Open the database containing the malloc data. The user specifies the
# database to use by passing the file-name on the command line.
#
proc open_database {} {
  if {[info exists ::BUILTIN]} {
    sqlite3 mddb :memory:
    mddb eval $::BUILTIN
    wm title . $::argv0
  } else {
    set zFilename [lindex $::argv 0]
    if {$zFilename eq ""} {
      set zFilename mallocs.sql
    }
    set fd [open $zFilename]
    set zHdr [read $fd 15]
    if {$zHdr eq "SQLite format 3"} {
      close $fd
      sqlite3 mddb $zFilename
    } else {
      seek $fd 0
      sqlite3 mddb :memory:
      mddb eval [read $fd]
      close $fd
    }
    wm title . $zFilename
  }

  mddb function lrange -argcount 3 lrange
  mddb function llength -argcount 1 llength
  mddb function trim_frames -argcount 1 trim_frames

  mddb eval {
    SELECT frame FROM frame 
    WHERE line LIKE '%malloc.c:%' OR line LIKE '%mem2.c:%'
  } {
    set ::O(ignore.$frame) 1
  }
}

open_database
bind $O(tree) <<TreeviewSelect>> [list populate_text_widget mddb]

populate_tree_widget mddb [mddb one {SELECT zTest FROM malloc LIMIT 1}]

Changes to test/printf.test.

3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
} {}
do_test printf-15.3 {
  sqlite3_snprintf_int 0 {} 0
} {abcdefghijklmnopqrstuvwxyz}

# Now test malloc() failure within a sqlite3_mprintf():
#
ifcapable memdebug {
  foreach var {a b c d} {
    set $var [string repeat $var 400]
  }
  set str1 "[string repeat A 360]%d%d%s"
  set str2 [string repeat B 5000]
  set zSuccess "[string repeat A 360]11[string repeat B 5000]"
  foreach ::iRepeat {0 1} {
    set nTestNum 1
    while {1} {
      sqlite3_memdebug_fail $nTestNum -repeat $::iRepeat
      set z [sqlite3_mprintf_str $str1 1 1 $str2]
      set nFail [sqlite3_memdebug_fail -1 -benign nBenign]
      do_test printf-malloc-$::iRepeat.$nTestNum {
        expr {($nFail>0 && $z eq "") || ($nFail==$nBenign && $z eq $zSuccess)}
      } {1}
      if {$nFail == 0} break
      incr nTestNum
    }
  }
}

finish_test







<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<

3753
3754
3755
3756
3757
3758
3759

3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779

3780
} {}
do_test printf-15.3 {
  sqlite3_snprintf_int 0 {} 0
} {abcdefghijklmnopqrstuvwxyz}

# Now test malloc() failure within a sqlite3_mprintf():
#

foreach var {a b c d} {
  set $var [string repeat $var 400]
}
set str1 "[string repeat A 360]%d%d%s"
set str2 [string repeat B 5000]
set zSuccess "[string repeat A 360]11[string repeat B 5000]"
foreach ::iRepeat {0 1} {
  set nTestNum 1
  while {1} {
    sqlite3_memdebug_fail $nTestNum -repeat $::iRepeat
    set z [sqlite3_mprintf_str $str1 1 1 $str2]
    set nFail [sqlite3_memdebug_fail -1 -benign nBenign]
    do_test printf-malloc-$::iRepeat.$nTestNum {
      expr {($nFail>0 && $z eq "") || ($nFail==$nBenign && $z eq $zSuccess)}
    } {1}
    if {$nFail == 0} break
    incr nTestNum
  }
}


finish_test

Changes to test/tableapi.test.

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
...
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
source $testdir/tester.tcl

ifcapable !gettable {
  finish_test
  return
}

ifcapable memdebug {
  source $testdir/malloc_common.tcl
}

do_test tableapi-1.0 {
  set ::dbx [sqlite3_open test.db]
  catch {sqlite_exec_printf $::dbx {DROP TABLE xyz} {}}
  sqlite3_exec_printf $::dbx {CREATE TABLE %s(a int, b text)} xyz
} {0 {}}
do_test tableapi-1.1 {
................................................................................
# each iteration.  $::dbx is a seperate connection, and on Windows, will
# cause the file deletion of test.db to fail, so we move the close of $::dbx
# up to here before the do_malloc_test.
do_test tableapi-99.0 {
  sqlite3_close $::dbx
} {SQLITE_OK}

ifcapable memdebug {
  do_malloc_test tableapi-7 -sqlprep {
    DROP TABLE IF EXISTS t1;
    CREATE TABLE t1(a,b);
    INSERT INTO t1 VALUES(1,2);
    INSERT INTO t1 VALUES(3,4);
    INSERT INTO t1 SELECT a+4, b+4 FROM t1;
    INSERT INTO t1 SELECT a+8, b+8 FROM t1;
  } -tclbody {
    set r [sqlite3_get_table_printf db {SELECT rowid, a, b FROM t1} {}]
    if {[llength $r]<26} {error "out of memory"}
  }
}

finish_test







<
|
<







 







<
|
|
|
|
|
|
|
|
|
|
<



18
19
20
21
22
23
24

25

26
27
28
29
30
31
32
...
233
234
235
236
237
238
239

240
241
242
243
244
245
246
247
248
249

250
251
252
source $testdir/tester.tcl

ifcapable !gettable {
  finish_test
  return
}


source $testdir/malloc_common.tcl


do_test tableapi-1.0 {
  set ::dbx [sqlite3_open test.db]
  catch {sqlite_exec_printf $::dbx {DROP TABLE xyz} {}}
  sqlite3_exec_printf $::dbx {CREATE TABLE %s(a int, b text)} xyz
} {0 {}}
do_test tableapi-1.1 {
................................................................................
# each iteration.  $::dbx is a seperate connection, and on Windows, will
# cause the file deletion of test.db to fail, so we move the close of $::dbx
# up to here before the do_malloc_test.
do_test tableapi-99.0 {
  sqlite3_close $::dbx
} {SQLITE_OK}


do_malloc_test tableapi-7 -sqlprep {
  DROP TABLE IF EXISTS t1;
  CREATE TABLE t1(a,b);
  INSERT INTO t1 VALUES(1,2);
  INSERT INTO t1 VALUES(3,4);
  INSERT INTO t1 SELECT a+4, b+4 FROM t1;
  INSERT INTO t1 SELECT a+8, b+8 FROM t1;
} -tclbody {
  set r [sqlite3_get_table_printf db {SELECT rowid, a, b FROM t1} {}]
  if {[llength $r]<26} {error "out of memory"}

}

finish_test

Changes to test/tester.tcl.

452
453
454
455
456
457
458





459
460
461
462
463
464
465
....
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
....
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
....
2061
2062
2063
2064
2065
2066
2067



2068
2069








2070
2071
2072
2073
2074
2075
2076
      }
      {^-+maxerror=.+$} {
        foreach {dummy cmdlinearg(maxerror)} [split $a =] break
      }
      {^-+malloctrace=.+$} {
        foreach {dummy cmdlinearg(malloctrace)} [split $a =] break
        if {$cmdlinearg(malloctrace)} {





          sqlite3_memdebug_log start
        }
      }
      {^-+backtrace=.+$} {
        foreach {dummy cmdlinearg(backtrace)} [split $a =] break
        sqlite3_memdebug_backtrace $cmdlinearg(backtrace)
      }
................................................................................
    incr nErr
  }
  if {[lindex [sqlite3_status SQLITE_STATUS_MALLOC_COUNT 0] 1]>0 ||
              [sqlite3_memory_used]>0} {
    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) {
      output2 "Writing unfreed memory log to \"./memleak.txt\""
      sqlite3_memdebug_dump ./memleak.txt
    }
  } else {
    output2 "All memory allocations freed - no leaks"
    ifcapable memdebug||mem5 {
      sqlite3_memdebug_dump ./memusage.txt
    }
  }
  show_memstats
  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 ""} {
    output2 "Number of malloc()  : [sqlite3_memdebug_malloc_count] calls"
  }
  if {$::cmdlinearg(malloctrace)} {
    output2 "Writing mallocs.sql..."
    memdebug_log_sql
    sqlite3_memdebug_log stop
    sqlite3_memdebug_log clear

    if {[sqlite3_memory_used]>0} {
      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
................................................................................
  set txt [$db eval "SELECT * FROM $master"]\n
  foreach tab $alltab {
    append txt [$db eval "SELECT * FROM $dbname.$tab"]\n
  }
  return [md5 $txt]
}

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 contents [read $fd]
      close $fd
    }
    set contents [string map {' ''} $contents]
    append sql "INSERT INTO ${database}.file VALUES('$f', '$contents');\n"
  }




  set fd [open $filename w]
  puts $fd "BEGIN; ${tbl}${tbl2}${tbl3}${sql} ; COMMIT;"








  close $fd
}

# Drop all tables in database [db]
proc drop_all_tables {{db db}} {
  ifcapable trigger&&foreignkey {
    set pk [$db one "PRAGMA foreign_keys"]







>
>
>
>
>







 







|





|










|
|


<

|

|







 







|







 







>
>
>

<
>
>
>
>
>
>
>
>







452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
....
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286

1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
....
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
....
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075

2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
      }
      {^-+maxerror=.+$} {
        foreach {dummy cmdlinearg(maxerror)} [split $a =] break
      }
      {^-+malloctrace=.+$} {
        foreach {dummy cmdlinearg(malloctrace)} [split $a =] break
        if {$cmdlinearg(malloctrace)} {
          if {0==$::sqlite_options(memdebug)} {
            set err "Error: --malloctrace=1 requires an SQLITE_MEMDEBUG build"
            puts stderr $err
            exit 1
          }
          sqlite3_memdebug_log start
        }
      }
      {^-+backtrace=.+$} {
        foreach {dummy cmdlinearg(backtrace)} [split $a =] break
        sqlite3_memdebug_backtrace $cmdlinearg(backtrace)
      }
................................................................................
    incr nErr
  }
  if {[lindex [sqlite3_status SQLITE_STATUS_MALLOC_COUNT 0] 1]>0 ||
              [sqlite3_memory_used]>0} {
    output2 "Unfreed memory: [sqlite3_memory_used] bytes in\
         [lindex [sqlite3_status SQLITE_STATUS_MALLOC_COUNT 0] 1] allocations"
    incr nErr
    ifcapable mem5||(mem3&&debug) {
      output2 "Writing unfreed memory log to \"./memleak.txt\""
      sqlite3_memdebug_dump ./memleak.txt
    }
  } else {
    output2 "All memory allocations freed - no leaks"
    ifcapable mem5 {
      sqlite3_memdebug_dump ./memusage.txt
    }
  }
  show_memstats
  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 ""} {
    output2 "Number of malloc()  : [sqlite3_memdebug_malloc_count] calls"
  }
  if {$::cmdlinearg(malloctrace)} {
    output2 "Writing mallocs.tcl..."
    memdebug_log_sql mallocs.tcl
    sqlite3_memdebug_log stop
    sqlite3_memdebug_log clear

    if {[sqlite3_memory_used]>0} {
      output2 "Writing leaks.tcl..."
      sqlite3_memdebug_log sync
      memdebug_log_sql leaks.tcl
    }
  }
  foreach f [glob -nocomplain test.db-*-journal] {
    forcedelete $f
  }
  foreach f [glob -nocomplain test.db-mj*] {
    forcedelete $f
................................................................................
  set txt [$db eval "SELECT * FROM $master"]\n
  foreach tab $alltab {
    append txt [$db eval "SELECT * FROM $dbname.$tab"]\n
  }
  return [md5 $txt]
}

proc memdebug_log_sql {filename} {

  set data [sqlite3_memdebug_log dump]
  set nFrame [expr [llength [lindex $data 0]]-2]
  if {$nFrame < 0} { return "" }

  set database temp

................................................................................
      set contents [read $fd]
      close $fd
    }
    set contents [string map {' ''} $contents]
    append sql "INSERT INTO ${database}.file VALUES('$f', '$contents');\n"
  }

  set escaped "BEGIN; ${tbl}${tbl2}${tbl3}${sql} ; COMMIT;"
  set escaped [string map [list "{" "\\{" "}" "\\}"] $escaped] 

  set fd [open $filename w]

  puts $fd "set BUILTIN {"
  puts $fd $escaped
  puts $fd "}"
  puts $fd {set BUILTIN [string map [list "\\{" "{" "\\}" "}"] $BUILTIN]}
  set mtv [open $::testdir/malloctraceviewer.tcl]
  set txt [read $mtv]
  close $mtv
  puts $fd $txt
  close $fd
}

# Drop all tables in database [db]
proc drop_all_tables {{db db}} {
  ifcapable trigger&&foreignkey {
    set pk [$db one "PRAGMA foreign_keys"]

Changes to test/triggerA.test.

196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
  db eval {
     DELETE FROM result4;
     UPDATE v5 SET b = main.v5.b+9900000 WHERE main.v5.x BETWEEN 3 AND 5;
     SELECT * FROM result4 ORDER BY a;
  }
} {3 305 3 9900305 4 404 4 9900404 5 504 5 9900504}

# Only run the reamining tests if memory debugging is turned on.
#
ifcapable !memdebug {
   puts "Skipping triggerA malloc tests: not compiled with -DSQLITE_MEMDEBUG..."
   finish_test
   return
}
source $testdir/malloc_common.tcl

# Save a copy of the current database configuration.
#
db close
forcedelete test.db-triggerA
copy_file test.db test.db-triggerA







<
<
<
<
<
<
<







196
197
198
199
200
201
202







203
204
205
206
207
208
209
  db eval {
     DELETE FROM result4;
     UPDATE v5 SET b = main.v5.b+9900000 WHERE main.v5.x BETWEEN 3 AND 5;
     SELECT * FROM result4 ORDER BY a;
  }
} {3 305 3 9900305 4 404 4 9900404 5 504 5 9900504}








source $testdir/malloc_common.tcl

# Save a copy of the current database configuration.
#
db close
forcedelete test.db-triggerA
copy_file test.db test.db-triggerA

Changes to test/vtab_err.test.

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
  BEGIN;
    CREATE TABLE r2(a, b, c);
    INSERT INTO r2 SELECT * FROM e;
    INSERT INTO e SELECT a||'x', b, c FROM r2;
  COMMIT;
}

ifcapable !memdebug {
   puts "Skipping vtab_err-2 tests: not compiled with -DSQLITE_MEMDEBUG..."
   finish_test
   return
}
source $testdir/malloc_common.tcl


do_malloc_test vtab_err-2 -tclprep { 
  register_echo_module [sqlite3_connection_pointer db]
} -sqlbody {
  BEGIN;







<
<
<
<
<







36
37
38
39
40
41
42





43
44
45
46
47
48
49
  BEGIN;
    CREATE TABLE r2(a, b, c);
    INSERT INTO r2 SELECT * FROM e;
    INSERT INTO e SELECT a||'x', b, c FROM r2;
  COMMIT;
}






source $testdir/malloc_common.tcl


do_malloc_test vtab_err-2 -tclprep { 
  register_echo_module [sqlite3_connection_pointer db]
} -sqlbody {
  BEGIN;