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
|
# 2018 May 19
#
# The author disclaims copyright to this source code. In place of
# a legal notice, here is a blessing:
#
# May you do good and not evil.
# May you find forgiveness for yourself and forgive others.
# May you share freely, never taking more than you give.
#
#***********************************************************************
#
package require sqlite3
package require Pgtcl
set db [pg_connect -conninfo "dbname=postgres user=postgres password=postgres"]
sqlite3 sqlite ""
proc execsql {sql} {
set sql [string map {{WITHOUT ROWID} {}} $sql]
set lSql [list]
set frag ""
while {[string length $sql]>0} {
set i [string first ";" $sql]
if {$i>=0} {
append frag [string range $sql 0 $i]
set sql [string range $sql $i+1 end]
if {[sqlite complete $frag]} {
lappend lSql $frag
set frag ""
}
} else {
set frag $sql
set sql ""
}
}
if {$frag != ""} {
lappend lSql $frag
}
#puts $lSql
set ret ""
set nChar 0
foreach stmt $lSql {
set res [pg_exec $::db $stmt]
set err [pg_result $res -error]
if {$err!=""} { error $err }
for {set i 0} {$i < [pg_result $res -numTuples]} {incr i} {
set t [pg_result $res -getTuple $i]
set nNew [string length $t]
if {$nChar>0 && ($nChar+$nNew+3)>75} {
append ret "\n "
set nChar 0
} else {
if {$nChar>0} {
append ret " "
incr nChar 3
}
}
incr nChar $nNew
append ret $t
}
pg_result $res -clear
}
set ret
}
proc execsql_test {tn sql} {
set res [execsql $sql]
set sql [string map {string_agg group_concat} $sql]
# set sql [string map [list {NULLS FIRST} {}] $sql]
# set sql [string map [list {NULLS LAST} {}] $sql]
puts $::fd "do_execsql_test $tn {"
puts $::fd " [string trim $sql]"
puts $::fd "} {$res}"
puts $::fd ""
}
proc errorsql_test {tn sql} {
set rc [catch {execsql $sql} msg]
if {$rc==0} {
error "errorsql_test SQL did not cause an error!"
}
set msg [lindex [split [string trim $msg] "\n"] 0]
puts $::fd "# PG says $msg"
set sql [string map {string_agg group_concat} $sql]
puts $::fd "do_test $tn { catch { execsql {"
puts $::fd " [string trim $sql]"
puts $::fd "} } } 1"
puts $::fd ""
}
# Same as [execsql_test], except coerce all results to floating point values
# with two decimal points.
#
proc execsql_float_test {tn sql} {
set F "%.4f"
set T 0.0001
set res [execsql $sql]
set res2 [list]
foreach r $res {
if {$r != ""} { set r [format $F $r] }
lappend res2 $r
}
set sql [string trim $sql]
puts $::fd [subst -nocommands {
do_test $tn {
set myres {}
foreach r [db eval {$sql}] {
lappend myres [format $F [set r]]
}
set res2 {$res2}
set i 0
foreach r [set myres] r2 [set res2] {
if {[set r]<([set r2]-$T) || [set r]>([set r2]+$T)} {
error "list element [set i] does not match: got=[set r] expected=[set r2]"
}
incr i
}
set {} {}
} {}
}]
}
proc start_test {name date} {
set dir [file dirname $::argv0]
set output [file join $dir $name.test]
set ::fd [open $output w]
puts $::fd [string trimleft "
# $date
#
# The author disclaims copyright to this source code. In place of
# a legal notice, here is a blessing:
#
# May you do good and not evil.
# May you find forgiveness for yourself and forgive others.
# May you share freely, never taking more than you give.
#
#***********************************************************************
# This file implements regression tests for SQLite library.
#
####################################################
# DO NOT EDIT! THIS FILE IS AUTOMATICALLY GENERATED!
####################################################
"]
puts $::fd {set testdir [file dirname $argv0]}
puts $::fd {source $testdir/tester.tcl}
puts $::fd "set testprefix $name"
puts $::fd ""
}
proc -- {args} {
puts $::fd "# $args"
}
proc ========== {args} {
puts $::fd "#[string repeat = 74]"
puts $::fd ""
}
proc finish_test {} {
puts $::fd finish_test
close $::fd
}
proc ifcapable {arg} {
puts $::fd "ifcapable $arg { finish_test ; return }"
}
|
