1# 2010 June 03
2#
3# The author disclaims copyright to this source code.  In place of
4# a legal notice, here is a blessing:
5#
6#    May you do good and not evil.
7#    May you find forgiveness for yourself and forgive others.
8#    May you share freely, never taking more than you give.
9#
10#***********************************************************************
11#
12# This file contains common code used by many different malloc tests
13# within the test suite.
14#
15
16proc wal_file_size {nFrame pgsz} {
17  expr {32 + ($pgsz+24)*$nFrame}
18}
19
20proc wal_frame_count {zFile pgsz} {
21  if {[file exists $zFile]==0} { return 0 }
22  set f [file size $zFile]
23  if {$f < 32} { return 0 }
24  expr {($f - 32) / ($pgsz+24)}
25}
26
27proc wal_cksum_intlist {ckv1 ckv2 intlist} {
28  upvar $ckv1 c1
29  upvar $ckv2 c2
30  foreach {v1 v2} $intlist {
31    set c1 [expr {($c1 + $v1 + $c2)&0xFFFFFFFF}]
32    set c2 [expr {($c2 + $v2 + $c1)&0xFFFFFFFF}]
33  }
34}
35
36
37# This proc calculates checksums in the same way as those used by SQLite
38# in WAL files. If the $endian argument is "big", then checksums are
39# calculated by interpreting data as an array of big-endian integers. If
40# it is "little", data is interpreted as an array of little-endian integers.
41#
42proc wal_cksum {endian ckv1 ckv2 blob} {
43  upvar $ckv1 c1
44  upvar $ckv2 c2
45
46  if {$endian!="big" && $endian!="little"} {
47    return -error "Bad value \"$endian\" - must be \"big\" or \"little\""
48  }
49  set scanpattern I*
50  if {$endian == "little"} { set scanpattern i* }
51
52  binary scan $blob $scanpattern values
53  wal_cksum_intlist c1 c2 $values
54}
55
56proc wal_set_walhdr {filename {intlist {}}} {
57  if {[llength $intlist]==6} {
58    set blob [binary format I6 $intlist]
59    set endian little
60    if {[lindex $intlist 0] & 0x00000001} { set endian big }
61    set c1 0
62    set c2 0
63    wal_cksum $endian c1 c2 $blob
64    append blob [binary format II $c1 $c2]
65
66    set fd [open $filename r+]
67    fconfigure $fd -translation binary
68    fconfigure $fd -encoding binary
69    seek $fd 0
70    puts -nonewline $fd $blob
71    close $fd
72  }
73
74  set fd [open $filename]
75  fconfigure $fd -translation binary
76  fconfigure $fd -encoding binary
77  set blob [read $fd 24]
78  close $fd
79
80  binary scan $blob I6 ints
81  set ints
82}
83
84proc wal_fix_walindex_cksum {hdrvar} {
85  upvar $hdrvar hdr
86  set c1 0
87  set c2 0
88  wal_cksum_intlist c1 c2 [lrange $hdr 0 9]
89  lset hdr 10 $c1
90  lset hdr 11 $c2
91}
92
93
94