Work toward enhanced functionality for json_valid() with deep checking
[sqlite.git] / test / wal_common.tcl
blob917ad598f6307567d79c63f58b431e817acb8f61
1 # 2010 June 03
3 # The author disclaims copyright to this source code. In place of
4 # a legal notice, here is a blessing:
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.
10 #***********************************************************************
12 # This file contains common code used by many different malloc tests
13 # within the test suite.
16 proc wal_file_size {nFrame pgsz} {
17 expr {32 + ($pgsz+24)*$nFrame}
20 proc 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)}
27 proc 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}]
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.
42 proc wal_cksum {endian ckv1 ckv2 blob} {
43 upvar $ckv1 c1
44 upvar $ckv2 c2
46 if {$endian!="big" && $endian!="little"} {
47 return -error "Bad value \"$endian\" - must be \"big\" or \"little\""
49 set scanpattern I*
50 if {$endian == "little"} { set scanpattern i* }
52 binary scan $blob $scanpattern values
53 wal_cksum_intlist c1 c2 $values
56 proc 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]
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
74 set fd [open $filename]
75 fconfigure $fd -translation binary
76 fconfigure $fd -encoding binary
77 set blob [read $fd 24]
78 close $fd
80 binary scan $blob I6 ints
81 set ints
84 proc 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