From 9015a7b063d96172512c54d84395d2b260d4d330 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 16 Jul 2016 11:42:38 +0000 Subject: [77d58e3a7a] Test case independence: io, load, msgcat, namespace, safe. --- tests/io.test | 16 ++++++++++++++-- tests/load.test | 54 ++++++++++++++++++++++++++++++++++------------------ tests/msgcat.test | 11 +++++++++-- tests/namespace.test | 13 ++++++++----- tests/safe.test | 20 ++++++------------- 5 files changed, 72 insertions(+), 42 deletions(-) diff --git a/tests/io.test b/tests/io.test index 6b6ad6d..9573cc6 100644 --- a/tests/io.test +++ b/tests/io.test @@ -4285,6 +4285,13 @@ test io-33.4 {Tcl_Gets with long line} { close $f set x } {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ} +set f [open $path(test3) w] +puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" +puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" +puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" +puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" +puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" +close $f test io-33.5 {Tcl_Gets with long line} { set f [open $path(test3)] set x [gets $f y] @@ -7141,7 +7148,12 @@ test io-52.10 {TclCopyChannel & encodings} {fcopy} { file size $path(utf8-fcopy.txt) } 5 -test io-52.11 {TclCopyChannel & encodings} {fcopy} { +test io-52.11 {TclCopyChannel & encodings} -setup { + set out [open $path(utf8-fcopy.txt) w] + fconfigure $out -encoding utf-8 -translation lf + puts $out "\u0410\u0410" + close $out +} -constraints {fcopy} -body { # binary to encoding => the input has to be # in utf-8 to make sense to the encoder @@ -7157,7 +7169,7 @@ test io-52.11 {TclCopyChannel & encodings} {fcopy} { close $out file size $path(kyrillic.txt) -} 3 +} -result 3 test io-52.12 {coverage of -translation auto} { file delete $path(test1) $path(test2) diff --git a/tests/load.test b/tests/load.test index 9536271..7c4b47f 100644 --- a/tests/load.test +++ b/tests/load.test @@ -124,9 +124,11 @@ test load-3.2 {error in _Init procedure, slave interpreter} \ test load-4.1 {reloading package into same interpreter} [list $dll $loaded] { list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg } {0 {}} -test load-4.2 {reloading package into same interpreter} [list $dll $loaded] { - list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg -} [list 1 "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""] +test load-4.2 {reloading package into same interpreter} -setup { + catch {load [file join $testDir pkga$ext] pkga} +} -constraints [list $dll $loaded] -returnCodes error -body { + load [file join $testDir pkga$ext] pkgb +} -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\"" test load-5.1 {file name not specified and no static package: pick default} \ [list $dll $loaded] { @@ -169,26 +171,40 @@ test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] { load {} More set x } {not loaded} -test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \ - [list teststaticpkg $dll $loaded] { - teststaticpkg Double 0 1 - teststaticpkg Double 0 1 - info loaded - } [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] +catch {load [file join $testDir pkga$ext] pkga} +catch {load [file join $testDir pkgb$ext] pkgb} +catch {load [file join $testDir pkge$ext] pkge} +set currentRealPackages [list [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] +test load-7.4 {Tcl_StaticPackage procedure, redundant calls} -setup { + teststaticpkg Test 1 0 + teststaticpkg Another 0 0 + teststaticpkg More 0 1 +} -constraints [list teststaticpkg $dll $loaded] -body { + teststaticpkg Double 0 1 + teststaticpkg Double 0 1 + info loaded +} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded] +teststaticpkg Test 1 1 +teststaticpkg Another 0 1 +teststaticpkg More 0 1 +teststaticpkg Double 0 1 test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] { - info loaded -} [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 teststaticpkg] { - list [catch {info loaded gorp} msg] $msg -} {1 {could not find interpreter "gorp"}} -test load-8.3 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] { - list [info loaded {}] [info loaded child] -} [list [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]] + lsort -index 1 [info loaded] +} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]] +test load-8.2 {TclGetLoadedPackages procedure} -body { + info loaded gorp +} -returnCodes error -result {could not find interpreter "gorp"} +test load-8.3a {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] { + lsort -index 1 [info loaded {}] +} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga] [list [file join $testDir pkgb$ext] Pkgb] {*}$alreadyLoaded]] +test load-8.3b {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] { + lsort -index 1 [info loaded child] +} [lsort -index 1 [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]] test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded teststaticpkg] { load [file join $testDir pkgb$ext] pkgb - list [info loaded {}] [lsort [info commands pkgb_*]] -} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_demo pkgb_sub pkgb_unsafe}] + list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]] +} [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}] interp delete child test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} \ diff --git a/tests/msgcat.test b/tests/msgcat.test index 8647f9c..ae35272 100644 --- a/tests/msgcat.test +++ b/tests/msgcat.test @@ -68,6 +68,7 @@ namespace eval ::msgcat::test { set result c } } + test msgcat-0.$count [list \ locale initialization from environment variables $setVars \ ] -setup { @@ -973,7 +974,10 @@ namespace eval ::msgcat::test { } set bgerrorsaved [interp bgerror {}] interp bgerror {} [namespace code callbackproc] - + + variable locale + if {![info exist locale]} { set locale [mclocale] } + test msgcat-14.1 {invokation loadcmd} -setup { mcforgetpackage mclocale $locale @@ -1068,7 +1072,7 @@ namespace eval ::msgcat::test { mc k1 } -returnCodes 1\ -result {fail} - + interp bgerror {} $bgerrorsaved cleanupTests @@ -1076,3 +1080,6 @@ namespace eval ::msgcat::test { namespace delete ::msgcat::test return +# Local Variables: +# mode: tcl +# End: diff --git a/tests/namespace.test b/tests/namespace.test index 55505f1..de7009d 100644 --- a/tests/namespace.test +++ b/tests/namespace.test @@ -846,6 +846,7 @@ test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} -setup { set ::x } } -result {314159} +variable ::x 314159 test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} { namespace eval test_ns_1 { variable x 777 @@ -889,23 +890,25 @@ test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} -setup { } -result {777} test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} { namespace eval test_ns_1 { + variable x 777 unset x set x ;# must be global x now } } {314159} -test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} { +test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body { namespace eval test_ns_1 { - list [catch {set wuzzat} msg] $msg + set wuzzat } -} {1 {can't read "wuzzat": no such variable}} +} -returnCodes error -result {can't read "wuzzat": no such variable} test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} { namespace eval test_ns_1 { variable a hello } set test_ns_1::a } {hello} -test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} { +test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -setup { namespace eval test_ns_1 {} +} -body { proc test_ns {} { set ::test_ns_1::a 0 } @@ -916,7 +919,7 @@ test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} { namespace eval test_ns_1 set a 1 namespace delete test_ns_1 return $a -} 1 +} -result 1 catch {unset a} catch {unset x} diff --git a/tests/safe.test b/tests/safe.test index 94c1755..6c9c6c9 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -211,8 +211,8 @@ test safe-7.3 {check that safe subinterpreters work} { } {ok {} 0} # test source control on file name +set i "a" test safe-8.1 {safe source control on file} -setup { - set i "a" catch {safe::interpDelete $i} } -body { safe::interpCreate $i @@ -221,7 +221,6 @@ test safe-8.1 {safe source control on file} -setup { safe::interpDelete $i } -result {wrong # args: should be "source ?-encoding E? fileName"} test safe-8.2 {safe source control on file} -setup { - set i "a" catch {safe::interpDelete $i} } -body { safe::interpCreate $i @@ -230,7 +229,6 @@ test safe-8.2 {safe source control on file} -setup { safe::interpDelete $i } -result {wrong # args: should be "source ?-encoding E? fileName"} test safe-8.3 {safe source control on file} -setup { - set i "a" catch {safe::interpDelete $i} set log {} proc safe-test-log {str} {lappend ::log $str} @@ -245,7 +243,6 @@ test safe-8.3 {safe source control on file} -setup { safe::interpDelete $i } -result {1 {permission denied} {{ERROR for slave a : ".": is a directory}}} test safe-8.4 {safe source control on file} -setup { - set i "a" catch {safe::interpDelete $i} set log {} proc safe-test-log {str} {global log; lappend log $str} @@ -260,7 +257,6 @@ test safe-8.4 {safe source control on file} -setup { safe::interpDelete $i } -result {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}}} test safe-8.5 {safe source control on file} -setup { - set i "a" catch {safe::interpDelete $i} set log {} proc safe-test-log {str} {global log; lappend log $str} @@ -279,7 +275,6 @@ test safe-8.5 {safe source control on file} -setup { safe::interpDelete $i } -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"]] test safe-8.6 {safe source control on file} -setup { - set i "a" catch {safe::interpDelete $i} set log {} proc safe-test-log {str} {global log; lappend log $str} @@ -296,7 +291,6 @@ test safe-8.6 {safe source control on file} -setup { safe::interpDelete $i } -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"]] test safe-8.7 {safe source control on file} -setup { - set i "a" catch {safe::interpDelete $i} set log {} proc safe-test-log {str} {global log; lappend log $str} @@ -315,7 +309,6 @@ test safe-8.7 {safe source control on file} -setup { safe::interpDelete $i } -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]] test safe-8.8 {safe source forbids -rsrc} -setup { - set i "a" catch {safe::interpDelete $i} safe::interpCreate $i } -body { @@ -349,8 +342,8 @@ test safe-8.10 {safe source and return} -setup { removeFile $returnScript } -result ok +set i "a" test safe-9.1 {safe interps' deleteHook} -setup { - set i "a" catch {safe::interpDelete $i} set res {} } -body { @@ -365,7 +358,6 @@ test safe-9.1 {safe interps' deleteHook} -setup { list [interp eval $i exit] $res } -result {{} {arg1 arg2 a}} test safe-9.2 {safe interps' error in deleteHook} -setup { - set i "a" catch {safe::interpDelete $i} set res {} set log {} @@ -531,14 +523,14 @@ test safe-11.7.1 {testing safe encoding} -setup { } -body { catch {interp eval $i encoding convertfrom} m o dict get $o -errorinfo -} -returnCodes ok -cleanup { +} -returnCodes ok -match glob -cleanup { unset -nocomplain m o safe::interpDelete $i } -result {wrong # args: should be "encoding convertfrom ?encoding? data" while executing "encoding convertfrom" invoked from within -"::interp invokehidden interp1 encoding convertfrom" +"::interp invokehidden interp* encoding convertfrom" invoked from within "encoding convertfrom" invoked from within @@ -555,14 +547,14 @@ test safe-11.8.1 {testing safe encoding} -setup { } -body { catch {interp eval $i encoding convertto} m o dict get $o -errorinfo -} -returnCodes ok -cleanup { +} -returnCodes ok -match glob -cleanup { unset -nocomplain m o safe::interpDelete $i } -result {wrong # args: should be "encoding convertto ?encoding? data" while executing "encoding convertto" invoked from within -"::interp invokehidden interp1 encoding convertto" +"::interp invokehidden interp* encoding convertto" invoked from within "encoding convertto" invoked from within -- cgit v0.12