From 1ff071777e6546bc8caa062aa06db59fbe0e8594 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 8 May 2002 05:51:05 +0000 Subject: * Fixes to test suite when there's a space in the working path. Thanks to Kevin Kenny. --- ChangeLog | 7 +++++++ tests/fileName.test | 4 ++-- tests/load.test | 12 ++++++------ tests/main.test | 22 +++++++++++----------- tests/tcltest.test | 29 ++++++++++++++++------------- 5 files changed, 42 insertions(+), 32 deletions(-) diff --git a/ChangeLog b/ChangeLog index 0b57fc6..6b1700d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2002-05-08 Don Porter + + * library/tcltest/tcltest.tcl: Corrected [uplevel] quoting when + [source]-ing test script in subdirectories. + * tests/tcltest.test: Fixes to test suite when there's a space + in the working path. Thanks to Kevin Kenny. + 2002-05-07 David Gravereaux -- Changes from Peter Spjuth diff --git a/tests/fileName.test b/tests/fileName.test index 9289bc9..3785709 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: fileName.test,v 1.20 2002/05/07 18:03:05 vincentdarley Exp $ +# RCS: @(#) $Id: fileName.test,v 1.21 2002/05/08 05:58:56 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1701,7 +1701,7 @@ test filename-15.6 {unix specific globbing} {unixOnly} { set result [list [catch {glob ~} msg] $msg] set env(HOME) $temp set result -} [list 0 [list [glob ~]/globTest/odd\\\[\]*?\{\}name]] +} [list 0 [list [lindex [glob ~] 0]/globTest/odd\\\[\]*?\{\}name]] catch {exec rm -f globTest/odd\\\[\]*?\{\}name} # The following tests are only valid for Windows systems. diff --git a/tests/load.test b/tests/load.test index bb31845..2a61bfc 100644 --- a/tests/load.test +++ b/tests/load.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: load.test,v 1.7 2000/04/10 17:19:01 ericm Exp $ +# RCS: @(#) $Id: load.test,v 1.8 2002/05/08 05:58:57 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -124,7 +124,7 @@ test load-5.1 {file name not specified and no static package: pick default} \ set result [info loaded x] interp delete x set result -} "{[file join $testDir pkga$ext] Pkga}" +} [list [list [file join $testDir pkga$ext] Pkga]] # On some platforms, like SunOS 4.1.3, these tests can't be run because # they cause the process to exit. @@ -160,21 +160,21 @@ if {[info command teststaticpkg] != ""} { teststaticpkg Double 0 1 teststaticpkg Double 0 1 info loaded - } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded" + } [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded] test load-8.1 {TclGetLoadedPackages procedure} [list $dll $loaded] { info loaded - } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded" + } [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded] test load-8.2 {TclGetLoadedPackages procedure} [list $dll $loaded] { list [catch {info loaded gorp} msg] $msg } {1 {could not find interpreter "gorp"}} test load-8.3 {TclGetLoadedPackages procedure} [list $dll $loaded] { list [info loaded {}] [info loaded child] - } "{{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {{{} Test} {[file join $testDir pkgb$ext] Pkgb}}" + } [list [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]] test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded] { load [file join $testDir pkgb$ext] pkgb list [info loaded {}] [lsort [info commands pkgb_*]] - } "{{[file join $testDir pkgb$ext] Pkgb} {{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {pkgb_sub pkgb_unsafe}" + } [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_sub pkgb_unsafe}] interp delete child } diff --git a/tests/main.test b/tests/main.test index 126c97b..4f91072 100644 --- a/tests/main.test +++ b/tests/main.test @@ -1,6 +1,6 @@ # This file contains a collection of tests for generic/tclMain.c. # -# RCS: @(#) $Id: main.test,v 1.7 2002/04/16 00:39:39 dgp Exp $ +# RCS: @(#) $Id: main.test,v 1.8 2002/05/08 05:58:57 dgp Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." @@ -48,7 +48,7 @@ namespace eval ::tcl::test::main { exec } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} script - catch {set f [open "|[interpreter] script" r]} + catch {set f [open "|[list [interpreter] script]" r]} } -body { read $f } -cleanup { @@ -62,7 +62,7 @@ namespace eval ::tcl::test::main { exec } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} -script - catch {set f [open "|[interpreter] -script" w+]} + catch {set f [open "|[list [interpreter] -script]" w+]} } -body { puts $f {puts [list $argv0 $argv $tcl_interactive]; exit} flush $f @@ -79,7 +79,7 @@ namespace eval ::tcl::test::main { exec } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} script - catch {set f [open "|[interpreter] script \u00c0" r]} + catch {set f [open "|[list [interpreter] script \u00c0]" r]} } -body { read $f } -cleanup { @@ -95,7 +95,7 @@ namespace eval ::tcl::test::main { exec } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} script - catch {set f [open "|[interpreter] script \u20ac" r]} + catch {set f [open "|[list [interpreter] script \u20ac]" r]} } -body { read $f } -cleanup { @@ -111,7 +111,7 @@ namespace eval ::tcl::test::main { exec } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} \u00c0 - catch {set f [open "|[interpreter] \u00c0" r]} + catch {set f [open "|[list [interpreter] \u00c0]" r]} } -body { read $f } -cleanup { @@ -127,7 +127,7 @@ namespace eval ::tcl::test::main { exec } -setup { makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac - catch {set f [open "|[interpreter] \u20ac" r]} + catch {set f [open "|[list [interpreter] \u20ac]" r]} } -body { read $f } -cleanup { @@ -514,7 +514,7 @@ namespace eval ::tcl::test::main { } -constraints { exec } -setup { - catch {set f [open "|[interpreter]" w+]} + catch {set f [open "|[list [interpreter]]" w+]} } -body { type $f { fconfigure stdin -blocking 0 @@ -530,7 +530,7 @@ namespace eval ::tcl::test::main { } -constraints { exec } -setup { - catch {set f [open "|[interpreter]" w+]} + catch {set f [open "|[list [interpreter]]" w+]} catch {fconfigure $f -blocking 0} } -body { type $f "fconfigure stdin -eofchar \\032 @@ -556,7 +556,7 @@ namespace eval ::tcl::test::main { exec } -setup { set cmd {makeFile "if 1 \{" script} - catch {set f [open "|[interpreter] < [eval $cmd]" r]} + catch {set f [open "|[list [interpreter]] < [list [eval $cmd]]" r]} catch {fconfigure $f -blocking 0} } -body { variable wait @@ -674,7 +674,7 @@ namespace eval ::tcl::test::main { } -constraints { exec Tcltest } -setup { - catch {set f [open "|[interpreter]" w+]} + catch {set f [open "|[list [interpreter]]" w+]} catch {fconfigure $f -blocking 0} } -body { type $f "testsetmainloop diff --git a/tests/tcltest.test b/tests/tcltest.test index 1078268..ad4aa85 100755 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -6,7 +6,7 @@ # Copyright (c) 2000 by Ajuba Solutions # All rights reserved. # -# RCS: @(#) $Id: tcltest.test,v 1.19 2002/04/15 17:04:29 dgp Exp $ +# RCS: @(#) $Id: tcltest.test,v 1.20 2002/05/08 05:51:05 dgp Exp $ set tcltestVersion [package require tcltest] namespace import -force ::tcltest::* @@ -365,9 +365,9 @@ test tcltest-6.6 {tcltest::errorFile (implicit errorChannel)} { set f2 [tcltest::errorFile $ef] set f3 [tcltest::errorChannel] set f4 [tcltest::errorFile] - list $f0 $f1 $f2 $f3 $f4 + subst {$f0;$f1;$f2;$f3;$f4} } - -result {stderr stderr .*efile file[0-9a-f]+ .*efile} + -result {stderr;stderr;.*efile;file[0-9a-f]+;.*efile} -match regexp -cleanup { tcltest::errorFile $of @@ -400,9 +400,9 @@ test tcltest-6.8 {tcltest::outputFile (implicit outputFile)} { set f2 [tcltest::outputFile $ef] set f3 [tcltest::outputChannel] set f4 [tcltest::outputFile] - list $f0 $f1 $f2 $f3 $f4 + subst {$f0;$f1;$f2;$f3;$f4} } - -result {stdout stdout .*efile file[0-9a-f]+ .*efile} + -result {stdout;stdout;.*efile;file[0-9a-f]+;.*efile} -match regexp -cleanup { tcltest::outputFile $of @@ -535,7 +535,7 @@ test tcltest-8.6 {tcltest::temporaryDirectory} { set f3 [tcltest::temporaryDirectory] list $f1 $f2 $f3 } - -result "$normaldirectory $current $current" + -result "[list $normaldirectory $current $current]" -cleanup { set tcltest::temporaryDirectory $old } @@ -551,7 +551,7 @@ test tcltest-8.6a {tcltest::temporaryDirectory - test format 2} -setup { list $f1 $f2 $f3 } -cleanup { set tcltest::temporaryDirectory $old -} -result "$normaldirectory $current $current" +} -result [list $normaldirectory $current $current] # -testdir, tcltest::testsDirectory test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {unixOrPc} { @@ -591,7 +591,7 @@ test tcltest-8.14 {tcltest::testsDirectory} { set f3 [tcltest::testsDirectory] list $f1 $f2 $f3 } - -result "$normaldirectory $current $current" + -result "[list $normaldirectory $current $current]" -cleanup { set tcltest::testsDirectory $old } @@ -613,7 +613,11 @@ test tcltest-8.60 {tcltest::workingDirectory} { set f5 [tcltest::workingDirectory] list $f1 $f2 $f3 $f4 $f5 } - -result "$normaldirectory $normaldirectory $current $current $current" + -result "[list $normaldirectory \ + $normaldirectory \ + $current \ + $current \ + $current]" -cleanup { set tcltest::workingDirectory $old cd $current @@ -772,13 +776,12 @@ test tcltest-12.4 {tcltest::loadFile} { set f5 [tcltest::loadFile] list $f1 $f2 $f3 $f4 $f5 } - -result "{} {} $loadfile { + -result "[list {} {} $loadfile { package require tcltest namespace import -force ::tcltest::* - puts \$::tcltest::loadScript + puts $::tcltest::loadScript exit -} $loadfile -" +} $loadfile]\n" -cleanup { set tcltest::loadScript $olds set tcltest::loadFile $oldf -- cgit v0.12