xref: /sqlite-3.40.0/test/pg_common.tcl (revision aeb4e6ee) 
1# 2018 May 19
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
13package require sqlite3
14package require Pgtcl
15
16set db [pg_connect -conninfo "dbname=postgres user=postgres password=postgres"]
17sqlite3 sqlite ""
18
19proc execsql {sql} {
20
21  set sql [string map {{WITHOUT ROWID} {}} $sql]
22
23  set lSql [list]
24  set frag ""
25  while {[string length $sql]>0} {
26    set i [string first ";" $sql]
27    if {$i>=0} {
28      append frag [string range $sql 0 $i]
29      set sql [string range $sql $i+1 end]
30      if {[sqlite complete $frag]} {
31        lappend lSql $frag
32        set frag ""
33      }
34    } else {
35      set frag $sql
36      set sql ""
37    }
38  }
39  if {$frag != ""} {
40    lappend lSql $frag
41  }
42  #puts $lSql
43
44  set ret ""
45  set nChar 0
46  foreach stmt $lSql {
47    set res [pg_exec $::db $stmt]
48    set err [pg_result $res -error]
49    if {$err!=""} { error $err }
50
51    for {set i 0} {$i < [pg_result $res -numTuples]} {incr i} {
52      set t [pg_result $res -getTuple $i]
53      set nNew [string length $t]
54      if {$nChar>0 && ($nChar+$nNew+3)>75} {
55        append ret "\n  "
56        set nChar 0
57      } else {
58        if {$nChar>0} {
59          append ret "   "
60          incr nChar 3
61        }
62      }
63      incr nChar $nNew
64      append ret $t
65    }
66    pg_result $res -clear
67  }
68
69  set ret
70}
71
72proc execsql_test {tn sql} {
73  set res [execsql $sql]
74  set sql [string map {string_agg group_concat} $sql]
75  # set sql [string map [list {NULLS FIRST} {}] $sql]
76  # set sql [string map [list {NULLS LAST} {}] $sql]
77  puts $::fd "do_execsql_test $tn {"
78  puts $::fd "  [string trim $sql]"
79  puts $::fd "} {$res}"
80  puts $::fd ""
81}
82
83proc errorsql_test {tn sql} {
84  set rc [catch {execsql $sql} msg]
85  if {$rc==0} {
86    error "errorsql_test SQL did not cause an error!"
87  }
88  set msg [lindex [split [string trim $msg] "\n"] 0]
89  puts $::fd "# PG says $msg"
90  set sql [string map {string_agg group_concat} $sql]
91  puts $::fd "do_test $tn { catch { execsql {"
92  puts $::fd "  [string trim $sql]"
93  puts $::fd "} } } 1"
94  puts $::fd ""
95}
96
97# Same as [execsql_test], except coerce all results to floating point values
98# with two decimal points.
99#
100proc execsql_float_test {tn sql} {
101  set F "%.4f"
102  set T 0.0001
103  set res [execsql $sql]
104  set res2 [list]
105  foreach r $res {
106    if {$r != ""} { set r [format $F $r] }
107    lappend res2 $r
108  }
109
110  set sql [string trim $sql]
111puts $::fd [subst -nocommands {
112do_test $tn {
113  set myres {}
114  foreach r [db eval {$sql}] {
115    lappend myres [format $F [set r]]
116  }
117  set res2 {$res2}
118  set i 0
119  foreach r [set myres] r2 [set res2] {
120    if {[set r]<([set r2]-$T) || [set r]>([set r2]+$T)} {
121      error "list element [set i] does not match: got=[set r] expected=[set r2]"
122    }
123    incr i
124  }
125  set {} {}
126} {}
127}]
128}
129
130proc start_test {name date} {
131  set dir [file dirname $::argv0]
132  set output [file join $dir $name.test]
133  set ::fd [open $output w]
134puts $::fd [string trimleft "
135# $date
136#
137# The author disclaims copyright to this source code.  In place of
138# a legal notice, here is a blessing:
139#
140#    May you do good and not evil.
141#    May you find forgiveness for yourself and forgive others.
142#    May you share freely, never taking more than you give.
143#
144#***********************************************************************
145# This file implements regression tests for SQLite library.
146#
147
148####################################################
149# DO NOT EDIT! THIS FILE IS AUTOMATICALLY GENERATED!
150####################################################
151"]
152  puts $::fd {set testdir [file dirname $argv0]}
153  puts $::fd {source $testdir/tester.tcl}
154  puts $::fd "set testprefix $name"
155  puts $::fd ""
156}
157
158proc -- {args} {
159  puts $::fd "# $args"
160}
161
162proc ========== {args} {
163  puts $::fd "#[string repeat = 74]"
164  puts $::fd ""
165}
166
167proc finish_test {} {
168  puts $::fd finish_test
169  close $::fd
170}
171
172proc ifcapable {arg} {
173   puts $::fd "ifcapable $arg { finish_test ; return }"
174}
175
176