sqlite/test/pg_common.tcl

174 lines
4.0 KiB
Tcl
Raw Normal View History

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