/ Check-in [d2140cae]
Login
SQLite training in Houston TX on 2019-11-05 (details)
Part of the 2019 Tcl Conference

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

Overview
Comment:Better integrate the new malloc related instrumentation with the test infrastructure. (CVS 4904)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: d2140cae39dcced63e3ad5771e52d522ce587c96
User & Date: danielk1977 2008-03-21 17:29:38
Context
2008-03-21
18:01
Defer allocating memory space to hold the array of column values and names in sqlite3_exec() until there is a need to use the array. In the common case where there is no callback, this avoids a malloc() call. (CVS 4905) check-in: d8686abc user: drh tags: trunk
17:29
Better integrate the new malloc related instrumentation with the test infrastructure. (CVS 4904) check-in: d2140cae user: danielk1977 tags: trunk
17:13
Make sure the text result of an aggregate function has the correct encoding. Ticket #3009. (CVS 4903) check-in: 13e388ce user: drh tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to test/tester.tcl.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
..
40
41
42
43
44
45
46









47
48
49
50
51
52
53
...
226
227
228
229
230
231
232






233
234
235
236
237
238
239
...
642
643
644
645
646
647
648
649

650
651
652
653


654
655
656
657
658
659
660
...
663
664
665
666
667
668
669

670
671
672
673
674
675
676


677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707


708
709
710


711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730


731
732
733
734
735
736
737
738
#    May you find forgiveness for yourself and forgive others.
#    May you share freely, never taking more than you give.
#
#***********************************************************************
# 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 $


set tcl_precision 15
set sqlite_pending_byte 0x0010000

# 
# Check the command-line arguments for a default soft-heap-limit.
................................................................................
# 
# Check the command-line arguments to set the memory debugger
# backtrace depth.
#
# 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 {[regexp {^--backtrace=(\d+)$} [lindex $argv $i] all value]} {
    sqlite3_memdebug_backtrace $value
    set argv [lreplace $argv $i $i]
  }
}

................................................................................
      sqlite3_memdebug_dump ./memusage.txt
    }
  }
  puts "Maximum memory usage: [sqlite3_memory_highwater 1] bytes"
  puts "Current memory usage: [sqlite3_memory_highwater] bytes"
  if {[info commands sqlite3_memdebug_malloc_count] ne ""} {
    puts "Number of malloc()  : [sqlite3_memdebug_malloc_count] calls"






  }
  foreach f [glob -nocomplain test.db-*-journal] {
    file delete -force $f
  }
  foreach f [glob -nocomplain test.db-mj*] {
    file delete -force $f
  }
................................................................................
  foreach prag {default_cache_size} {
    append txt $prag-[$db eval "PRAGMA $prag"]\n
  }
  # puts txt=$txt
  return [md5 $txt]
}

proc memdebug_log_sql {database} {

  set data [sqlite3_memdebug_log dump]
  set nFrame [expr [llength [lindex $data 0]]-2]

  if {$nFrame < 0} { return "" }



  set tbl "CREATE TABLE ${database}.malloc(nCall, nByte"
  for {set ii 1} {$ii <= $nFrame} {incr ii} {
    append tbl ", f${ii}"
  }
  append tbl ");\n"

................................................................................
    append sql "INSERT INTO ${database}.malloc VALUES([join $e ,]);\n"
    foreach f [lrange $e 2 end] {
      set frames($f) 1
    }
  }

  set tbl2 "CREATE TABLE ${database}.frame(frame INTEGER PRIMARY KEY, line);\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"
  }



  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
    }
  }
}
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
}

# Copy file $from into $to. This is used because some versions of
# TCL for windows (notably the 8.4.1 binary package shipped with the
# current mingw release) have a broken "file copy" command.
#
proc copy_file {from to} {







|







 







>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>







 







|
>


<

>
>







 







>






|
>
>
|
<
|
<
|
|
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
>
>
|
<

>
>

<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
>
>
|







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
..
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
...
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
...
657
658
659
660
661
662
663
664
665
666
667

668
669
670
671
672
673
674
675
676
677
...
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697

698

699
700











701













702
703
704

705
706
707
708




709














710
711
712
713
714
715
716
717
718
719
#    May you find forgiveness for yourself and forgive others.
#    May you share freely, never taking more than you give.
#
#***********************************************************************
# This file implements some common TCL routines used for regression
# testing the SQLite library
#
# $Id: tester.tcl,v 1.109 2008/03/21 17:29:38 danielk1977 Exp $


set tcl_precision 15
set sqlite_pending_byte 0x0010000

# 
# Check the command-line arguments for a default soft-heap-limit.
................................................................................
# 
# Check the command-line arguments to set the memory debugger
# backtrace depth.
#
# 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
    set argv [lreplace $argv $i $i]
  }
}

................................................................................
      sqlite3_memdebug_dump ./memusage.txt
    }
  }
  puts "Maximum memory usage: [sqlite3_memory_highwater 1] bytes"
  puts "Current memory usage: [sqlite3_memory_highwater] bytes"
  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
  }
  foreach f [glob -nocomplain test.db-mj*] {
    file delete -force $f
  }
................................................................................
  foreach prag {default_cache_size} {
    append txt $prag-[$db eval "PRAGMA $prag"]\n
  }
  # puts txt=$txt
  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 tbl "CREATE TABLE ${database}.malloc(nCall, nByte"
  for {set ii 1} {$ii <= $nFrame} {incr ii} {
    append tbl ", f${ii}"
  }
  append tbl ");\n"

................................................................................
    append sql "INSERT INTO ${database}.malloc VALUES([join $e ,]);\n"
    foreach f [lrange $e 2 end] {
      set frames($f) 1
    }
  }

  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
  }



  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"
  }



















  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
# TCL for windows (notably the 8.4.1 binary package shipped with the
# current mingw release) have a broken "file copy" command.
#
proc copy_file {from to} {