aboutsummaryrefslogtreecommitdiff
path: root/test/tester.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'test/tester.tcl')
-rw-r--r--test/tester.tcl94
1 files changed, 30 insertions, 64 deletions
diff --git a/test/tester.tcl b/test/tester.tcl
index 5754d7037..164ee47f4 100644
--- a/test/tester.tcl
+++ b/test/tester.tcl
@@ -310,66 +310,6 @@ proc do_delete_file {force args} {
}
}
-if {$::tcl_platform(platform) eq "windows"} {
- proc do_remove_win32_dir {args} {
- set nRetry [getFileRetries] ;# Maximum number of retries.
- set nDelay [getFileRetryDelay] ;# Delay in ms before retrying.
-
- foreach dirName $args {
- # On windows, sometimes even a [remove_win32_dir] can fail just after
- # a directory is emptied. The cause is usually "tag-alongs" - programs
- # like anti-virus software, automatic backup tools and various explorer
- # extensions that keep a file open a little longer than we expect,
- # causing the delete to fail.
- #
- # The solution is to wait a short amount of time before retrying the
- # removal.
- #
- if {$nRetry > 0} {
- for {set i 0} {$i < $nRetry} {incr i} {
- set rc [catch {
- remove_win32_dir $dirName
- } msg]
- if {$rc == 0} break
- if {$nDelay > 0} { after $nDelay }
- }
- if {$rc} { error $msg }
- } else {
- remove_win32_dir $dirName
- }
- }
- }
-
- proc do_delete_win32_file {args} {
- set nRetry [getFileRetries] ;# Maximum number of retries.
- set nDelay [getFileRetryDelay] ;# Delay in ms before retrying.
-
- foreach fileName $args {
- # On windows, sometimes even a [delete_win32_file] can fail just after
- # a file is closed. The cause is usually "tag-alongs" - programs like
- # anti-virus software, automatic backup tools and various explorer
- # extensions that keep a file open a little longer than we expect,
- # causing the delete to fail.
- #
- # The solution is to wait a short amount of time before retrying the
- # delete.
- #
- if {$nRetry > 0} {
- for {set i 0} {$i < $nRetry} {incr i} {
- set rc [catch {
- delete_win32_file $fileName
- } msg]
- if {$rc == 0} break
- if {$nDelay > 0} { after $nDelay }
- }
- if {$rc} { error $msg }
- } else {
- delete_win32_file $fileName
- }
- }
- }
-}
-
proc execpresql {handle args} {
trace remove execution $handle enter [list execpresql $handle]
if {[info exists ::G(perm:presql)]} {
@@ -554,7 +494,7 @@ if {[info exists cmdlinearg]==0} {
}
unset -nocomplain a
set testdir [file normalize $testdir]
- set cmdlinearg(TESTFIXTURE_HOME) [pwd]
+ set cmdlinearg(TESTFIXTURE_HOME) [file dirname [info nameofexec]]
set cmdlinearg(INFO_SCRIPT) [file normalize [info script]]
set argv0 [file normalize $argv0]
if {$cmdlinearg(testdir)!=""} {
@@ -847,6 +787,9 @@ proc do_test {name cmd expected} {
}
} else {
set ok [expr {[string compare $result $expected]==0}]
+ if {!$ok} {
+ set ok [fpnum_compare $result $expected]
+ }
}
if {!$ok} {
# if {![info exists ::testprefix] || $::testprefix eq ""} {
@@ -897,7 +840,7 @@ proc catchsafecmd {db {cmd ""}} {
proc catchcmdex {db {cmd ""}} {
global CLI
set out [open cmds.txt w]
- fconfigure $out -encoding binary -translation binary
+ fconfigure $out -translation binary
puts -nonewline $out $cmd
close $out
set line "exec -keepnewline -- $CLI $db < cmds.txt"
@@ -905,7 +848,7 @@ proc catchcmdex {db {cmd ""}} {
foreach chan $chans {
catch {
set modes($chan) [fconfigure $chan]
- fconfigure $chan -encoding binary -translation binary -buffering none
+ fconfigure $chan -translation binary -buffering none
}
}
set rc [catch { eval $line } msg]
@@ -1042,7 +985,7 @@ proc query_plan_graph {sql} {
}
set a "\n QUERY PLAN\n"
append a [append_graph " " dx cx 0]
- regsub -all { 0x[A-F0-9]+\y} $a { xxxxxx} a
+ regsub -all {SUBQUERY 0x[A-F0-9]+\y} $a {SUBQUERY xxxxxx} a
regsub -all {(MATERIALIZE|CO-ROUTINE|SUBQUERY) \d+\y} $a {\1 xxxxxx} a
regsub -all {\((join|subquery)-\d+\)} $a {(\1-xxxxxx)} a
return $a
@@ -1113,6 +1056,29 @@ proc do_eqp_test {name sql res} {
}
}
+# Do both an eqp_test and an execsql_test on the same SQL.
+#
+proc do_eqp_execsql_test {name sql res1 res2} {
+ if {[regexp {^\s+QUERY PLAN\n} $res1]} {
+
+ set query_plan [query_plan_graph $sql]
+
+ if {[list {*}$query_plan]==[list {*}$res1]} {
+ uplevel [list do_test ${name}a [list set {} ok] ok]
+ } else {
+ uplevel [list \
+ do_test ${name}a [list query_plan_graph $sql] $res1
+ ]
+ }
+ } else {
+ if {[string index $res 0]!="/"} {
+ set res1 "/*$res1*/"
+ }
+ uplevel do_execsql_test ${name}a [list "EXPLAIN QUERY PLAN $sql"] [list $res1]
+ }
+ uplevel do_execsql_test ${name}b [list $sql] [list $res2]
+}
+
#-------------------------------------------------------------------------
# Usage: do_select_tests PREFIX ?SWITCHES? TESTLIST