AryaWu/sqlite

1# 2018 May 192#3# The author disclaims copyright to this source code.  In place of4# 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 sqlite314package require Pgtcl15 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 $frag32        set frag ""33      }34    } else {35      set frag $sql36      set sql ""37    }38  }39  if {$frag != ""} {40    lappend lSql $frag41  }42  #puts $lSql43 44  set ret ""45  set nChar 046  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 057      } else {58        if {$nChar>0} {59          append ret "   "60          incr nChar 361        }62      }63      incr nChar $nNew64      append ret $t65    }66    pg_result $res -clear67  }68 69  set ret70}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 values98# with two decimal points.99#100proc execsql_float_test {tn sql} {101  set F "%.4f"102  set T 0.0001103  set res [execsql $sql]104  set res2 [list]105  foreach r $res { 106    if {$r != ""} { set r [format $F $r] }107    lappend res2 $r108  }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 0119  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 i124  }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# $date136#137# The author disclaims copyright to this source code.  In place of138# 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_test169  close $::fd170}171 172proc ifcapable {arg} {173   puts $::fd "ifcapable $arg { finish_test ; return }"174}175 176