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