summaryrefslogtreecommitdiffstats
path: root/tests/safe.test
diff options
context:
space:
mode:
authorkjnash <k.j.nash@usa.net>2020-07-18 23:20:21 (GMT)
committerkjnash <k.j.nash@usa.net>2020-07-18 23:20:21 (GMT)
commit52aab51e7fe30231ac109fec7af390a3a7813954 (patch)
tree8f62a5fc3f78792fd470244f652ff6043af4bc68 /tests/safe.test
parent4e13b912904dde7532def3dc4d813484c6a8e00b (diff)
parentf48f2735de3b116e4ba24df71f4408ff4b34ab5b (diff)
downloadtcl-52aab51e7fe30231ac109fec7af390a3a7813954.zip
tcl-52aab51e7fe30231ac109fec7af390a3a7813954.tar.gz
tcl-52aab51e7fe30231ac109fec7af390a3a7813954.tar.bz2
Merge safe-bugfixes-8-6
Diffstat (limited to 'tests/safe.test')
-rw-r--r--tests/safe.test180
1 files changed, 119 insertions, 61 deletions
diff --git a/tests/safe.test b/tests/safe.test
index 34f5964..fafbb5d 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -23,9 +23,8 @@ foreach i [interp slaves] {
interp delete $i
}
-set saveAutoPath $::auto_path
+set SaveAutoPath $::auto_path
set ::auto_path [info library]
-
set TestsDir [file normalize [file dirname [info script]]]
set PathMapp [list $tcl_library TCLLIB $TestsDir TESTSDIR]
@@ -196,6 +195,7 @@ test safe-6.3 {test safe interpreters knowledge of the world} {
lsort $r
} {byteOrder engine pathSeparator platform pointerSize wordSize}
+rename SafeEval {}
# More test should be added to check that hostname, nameofexecutable, aren't
# leaking infos, but they still do...
@@ -215,7 +215,6 @@ test safe-7.0a {example tclIndex commands, test in master interpreter} -setup {
set ::auto_path $tmpAutoPath
auto_reset
} -match glob -result {0 ok1 0 ok2}
-
test safe-7.0b {example tclIndex commands, negative test in master interpreter} -setup {
set tmpAutoPath $::auto_path
lappend ::auto_path [file join $TestsDir auto0]
@@ -230,7 +229,6 @@ test safe-7.0b {example tclIndex commands, negative test in master interpreter}
set ::auto_path $tmpAutoPath
auto_reset
} -match glob -result {1 {invalid command name "report1"} 1 {invalid command name "report2"}}
-
test safe-7.0c {example pkgIndex.tcl packages, test in master interpreter, child directories} -setup {
set tmpAutoPath $::auto_path
lappend ::auto_path [file join $TestsDir auto0]
@@ -240,7 +238,6 @@ test safe-7.0c {example pkgIndex.tcl packages, test in master interpreter, child
set code4 [catch {package require SafeTestPackage2} msg4]
set code5 [catch HeresPackage1 msg5]
set code6 [catch HeresPackage2 msg6]
-
list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
} -cleanup {
set ::auto_path $tmpAutoPath
@@ -249,7 +246,6 @@ test safe-7.0c {example pkgIndex.tcl packages, test in master interpreter, child
catch {rename HeresPackage1 {}}
catch {rename HeresPackage2 {}}
} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
-
test safe-7.0d {example pkgIndex.tcl packages, test in master interpreter, main directories} -setup {
set tmpAutoPath $::auto_path
lappend ::auto_path [file join $TestsDir auto0 auto1] \
@@ -260,7 +256,6 @@ test safe-7.0d {example pkgIndex.tcl packages, test in master interpreter, main
set code4 [catch {package require SafeTestPackage2} msg4]
set code5 [catch HeresPackage1 msg5]
set code6 [catch HeresPackage2 msg6]
-
list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
} -cleanup {
set ::auto_path $tmpAutoPath
@@ -269,7 +264,6 @@ test safe-7.0d {example pkgIndex.tcl packages, test in master interpreter, main
catch {rename HeresPackage1 {}}
catch {rename HeresPackage2 {}}
} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
-
test safe-7.0e {example modules packages, test in master interpreter, replace path} -setup {
set oldTm [tcl::tm::path list]
foreach path $oldTm {
@@ -284,7 +278,6 @@ test safe-7.0e {example modules packages, test in master interpreter, replace pa
set out0 [test0::try0]
set out1 [mod1::test1::try1]
set out2 [mod2::test2::try2]
-
list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $TestsDir auto0 modules]
@@ -297,7 +290,6 @@ test safe-7.0e {example modules packages, test in master interpreter, replace pa
catch {namespace delete ::test0}
catch {namespace delete ::mod1}
} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}
-
test safe-7.0f {example modules packages, test in master interpreter, append to path} -setup {
tcl::tm::path add [file join $TestsDir auto0 modules]
} -body {
@@ -308,7 +300,6 @@ test safe-7.0f {example modules packages, test in master interpreter, append to
set out0 [test0::try0]
set out1 [mod1::test1::try1]
set out2 [mod2::test2::try2]
-
list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $TestsDir auto0 modules]
@@ -416,9 +407,9 @@ test safe-7.3 {check that safe subinterpreters work} {
}
set i [safe::interpCreate]
set j [safe::interpCreate [list $i x]]
- list $g $h [interp eval $j {join {o k} ""}] [safe::interpDelete $i] [interp exists $j] [info vars ::safe::S*]
+ list $g $h [interp eval $j {join {o k} ""}] [safe::interpDelete $i] \
+ [interp exists $j] [info vars ::safe::S*]
} {{} {} ok {} 0 {}}
-
test safe-7.4 {tests specific path and positive search with conventional AutoPathSync} -setup {
# All ::safe commands are loaded at start of file.
set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}]
@@ -462,7 +453,6 @@ test safe-7.4http {tests specific path and positive search, uses http1.0} -body
[catch {interp eval $i {package require http 1}} msg] $msg -- \
$mappA -- [safe::interpDelete $i]
} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.0 -- {TCLLIB *TCLLIB/http1.0} -- {}}
-
test safe-7.5 {tests positive and negative module loading with conventional AutoPathSync} -setup {
# All ::safe commands are loaded at start of file.
set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}]
@@ -493,24 +483,28 @@ test safe-7.5 {tests positive and negative module loading with conventional Auto
} -result {1 {can't find package shell} 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
$i eval {source}
} -returnCodes error -cleanup {
safe::interpDelete $i
+ unset 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
$i eval {source a b c d e}
} -returnCodes error -cleanup {
safe::interpDelete $i
+ unset 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}
@@ -521,10 +515,12 @@ test safe-8.3 {safe source control on file} -setup {
list [catch {$i eval {source .}} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
safe::interpDelete $i
+ rename safe-test-log {}
+ unset i log
} -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}
@@ -535,10 +531,12 @@ test safe-8.4 {safe source control on file} -setup {
list [catch {$i eval {source /abc/def}} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
safe::interpDelete $i
+ rename safe-test-log {}
+ unset i log
} -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}
@@ -553,10 +551,12 @@ test safe-8.5 {safe source control on file} -setup {
} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
safe::interpDelete $i
+ rename safe-test-log {}
+ unset i log
} -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}
@@ -569,10 +569,12 @@ test safe-8.6 {safe source control on file} -setup {
} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
safe::interpDelete $i
+ rename safe-test-log {}
+ unset i log
} -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}
@@ -587,14 +589,16 @@ test safe-8.7 {safe source control on file} -setup {
} msg] $msg $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
safe::interpDelete $i
+ rename safe-test-log {}
+ unset i log
} -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} emptyTest {
# Disabled this test. It was only useful for long unsupported
# Mac OS 9 systems. [Bug 860a9f1945]
} {}
test safe-8.9 {safe source and return} -setup {
+ set i "a"
set returnScript [makeFile {return "ok"} return.tcl]
catch {safe::interpDelete $i}
} -body {
@@ -604,8 +608,10 @@ test safe-8.9 {safe source and return} -setup {
} -cleanup {
catch {safe::interpDelete $i}
removeFile $returnScript
+ unset i
} -result ok
test safe-8.10 {safe source and return} -setup {
+ set i "a"
set returnScript [makeFile {return -level 2 "ok"} return.tcl]
catch {safe::interpDelete $i}
} -body {
@@ -618,10 +624,11 @@ test safe-8.10 {safe source and return} -setup {
} -cleanup {
catch {safe::interpDelete $i}
removeFile $returnScript
+ unset i
} -result ok
-set i "a"
test safe-9.1 {safe interps' deleteHook} -setup {
+ set i "a"
catch {safe::interpDelete $i}
set res {}
} -body {
@@ -634,8 +641,12 @@ test safe-9.1 {safe interps' deleteHook} -setup {
}
safe::interpCreate $i -deleteHook "testDelHook arg1 arg2"
list [interp eval $i exit] $res
+} -cleanup {
+ catch {rename testDelHook {}}
+ unset i 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 {}
@@ -656,7 +667,9 @@ test safe-9.2 {safe interps' error in deleteHook} -setup {
list [safe::interpDelete $i] $res $log
} -cleanup {
safe::setLogCmd $prevlog
- unset log
+ catch {rename testDelHook {}}
+ rename safe-test-log {}
+ unset i log res
} -result {{} {arg1 arg2 a} {{NOTICE for slave a : About to delete} {ERROR for slave a : Delete hook error (being catched)} {NOTICE for slave a : Deleted}}}
test safe-9.3 {dual specification of statics} -returnCodes error -body {
safe::interpCreate -stat true -nostat
@@ -687,15 +700,16 @@ test safe-9.6 {interpConfigure widget like behaviour} -body {
safe::interpConfigure $i]
} -cleanup {
safe::interpDelete $i
-} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath * -statics 0 -nested 0 -deleteHook toto}}
+} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}}\
+ {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\
+ {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}}\
+ {-accessPath * -statics 0 -nested 0 -deleteHook toto}}
test safe-9.7 {interpConfigure widget like behaviour (demystified)} -body {
# this test shall work, believed equivalent to 9.6
set i [safe::interpCreate \
-noStatics \
-nestedLoadOk \
- -deleteHook {foo bar} \
- ]
-
+ -deleteHook {foo bar}]
safe::interpConfigure $i -accessPath /foo/bar
set a [safe::interpConfigure $i]
set b [safe::interpConfigure $i -aCCess]
@@ -710,8 +724,11 @@ test safe-9.7 {interpConfigure widget like behaviour (demystified)} -body {
list $a $b $c $d $e $f $g
} -cleanup {
safe::interpDelete $i
-} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath * -statics 0 -nested 0 -deleteHook toto}}
-
+ unset -nocomplain a b c d e f g i
+} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}}\
+ {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\
+ {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}}\
+ {-accessPath * -statics 0 -nested 0 -deleteHook toto}}
test safe-9.8 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset)} -setup {
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library \
@@ -735,7 +752,6 @@ test safe-9.8 {interpConfigure change the access path; tclIndex commands unaffec
safe::interpConfigure $i -accessPath [list $tcl_library \
[file join $TestsDir auto0 auto2] \
[file join $TestsDir auto0 auto1]]
-
# Inspect.
set confB [safe::interpConfigure $i]
set mappB [mapList $PathMapp [dict get $confB -accessPath]]
@@ -752,7 +768,6 @@ test safe-9.8 {interpConfigure change the access path; tclIndex commands unaffec
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\
{TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
{TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}}
-
test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset)} -setup {
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library \
@@ -774,7 +789,6 @@ test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffec
safe::interpConfigure $i -accessPath [list $tcl_library \
[file join $TestsDir auto0 auto2] \
[file join $TestsDir auto0 auto1]]
-
# Inspect.
set confB [safe::interpConfigure $i]
set mappB [mapList $PathMapp [dict get $confB -accessPath]]
@@ -792,7 +806,6 @@ test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffec
0 ok1 0 ok2 --\
{TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
{TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}}
-
test safe-9.10 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement} -setup {
} -body {
# For complete correspondence to safe-9.10opt, include auto0 in access path.
@@ -800,7 +813,6 @@ test safe-9.10 {interpConfigure change the access path; pkgIndex.tcl packages un
[file join $TestsDir auto0] \
[file join $TestsDir auto0 auto1] \
[file join $TestsDir auto0 auto2]]]
-
# Inspect.
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
@@ -818,7 +830,6 @@ test safe-9.10 {interpConfigure change the access path; pkgIndex.tcl packages un
[file join $TestsDir auto0] \
[file join $TestsDir auto0 auto2] \
[file join $TestsDir auto0 auto1]]
-
# Inspect.
set confB [safe::interpConfigure $i]
set mappB [mapList $PathMapp [dict get $confB -accessPath]]
@@ -839,13 +850,11 @@ test safe-9.10 {interpConfigure change the access path; pkgIndex.tcl packages un
{TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
{TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\
0 OK1 0 OK2}
-
test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0} -setup {
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library \
[file join $TestsDir auto0 auto1] \
[file join $TestsDir auto0 auto2]]]
-
# Inspect.
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
@@ -859,7 +868,6 @@ test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages un
safe::interpConfigure $i -accessPath [list $tcl_library \
[file join $TestsDir auto0 auto2] \
[file join $TestsDir auto0 auto1]]
-
# Inspect.
set confB [safe::interpConfigure $i]
set mappB [mapList $PathMapp [dict get $confB -accessPath]]
@@ -872,8 +880,9 @@ test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages un
set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
- list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB -- \
- $code5 $msg5 $code6 $msg6
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
+ $mappA -- $mappB -- \
+ $code5 $msg5 $code6 $msg6
} -cleanup {
safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
@@ -908,7 +917,8 @@ test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages fa
set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3]
set code6 [catch {interp eval $i {package require SafeTestPackage2}} msg6]
- list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- $mappA -- $mappB
+ list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \
+ $mappA -- $mappB
} -cleanup {
safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\
@@ -982,7 +992,6 @@ test safe-9.21 {interpConfigure change the access path; check module loading; st
safe::interpConfigure $i -accessPath [list $tcl_library \
[file join $TestsDir auto0 auto1] \
[file join $TestsDir auto0 auto2]]
-
# Inspect.
set confB [safe::interpConfigure $i]
set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
@@ -1004,9 +1013,10 @@ test safe-9.21 {interpConfigure change the access path; check module loading; st
set out1 [interp eval $i {mod1::test1::try1}]
set out2 [interp eval $i {mod2::test2::try2}]
- list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- \
- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
- $out0 $out1 $out2
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $TestsDir auto0 modules]
foreach path [lreverse $oldTm] {
@@ -1044,7 +1054,6 @@ test safe-9.22 {interpConfigure change the access path; check module loading; st
safe::interpConfigure $i -accessPath [list $tcl_library \
[file join $TestsDir auto0 auto1] \
[file join $TestsDir auto0 auto2]]
-
# Inspect.
set confB [safe::interpConfigure $i]
set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
@@ -1061,9 +1070,10 @@ test safe-9.22 {interpConfigure change the access path; check module loading; st
set out1 [interp eval $i {mod1::test1::try1}]
set out2 [interp eval $i {mod2::test2::try2}]
- list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- \
- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
- $out0 $out1 $out2
+ list [lsort [list $path0 $path1 $path2]] -- $modsA --\
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $TestsDir auto0 modules]
foreach path [lreverse $oldTm] {
@@ -1106,7 +1116,6 @@ test safe-9.23 {interpConfigure change the access path; check module loading; st
safe::interpConfigure $i -accessPath [list $tcl_library \
[file join $TestsDir auto0 auto1] \
[file join $TestsDir auto0 auto2]]
-
# Inspect.
set confB [safe::interpConfigure $i]
set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
@@ -1128,10 +1137,10 @@ test safe-9.23 {interpConfigure change the access path; check module loading; st
set out1 [interp eval $i {mod1::test1::try1}]
set out2 [interp eval $i {mod2::test2::try2}]
- list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- \
- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
- $out0 $out1 $out2
-
+ list [lsort [list $path0 $path1 $path2]] -- $modsA --\
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $TestsDir auto0 modules]
foreach path [lreverse $oldTm] {
@@ -1174,7 +1183,6 @@ test safe-9.24 {interpConfigure change the access path; check module loading; st
safe::interpConfigure $i -accessPath [list $tcl_library \
[file join $TestsDir auto0 auto1] \
[file join $TestsDir auto0 auto2]]
-
# Inspect.
set confB [safe::interpConfigure $i]
set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
@@ -1191,9 +1199,10 @@ test safe-9.24 {interpConfigure change the access path; check module loading; st
set out1 [interp eval $i {mod1::test1::try1}]
set out2 [interp eval $i {mod2::test2::try2}]
- list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- \
- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
- $out0 $out1 $out2
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $TestsDir auto0 modules]
foreach path [lreverse $oldTm] {
@@ -1522,6 +1531,7 @@ test safe-13.7a {mimic the glob call by tclPkgUnknown in a safe interpreter with
safe::interpDelete $i
removeDirectory $testdir
} -result {EXPECTED/deleteme/pkgIndex.tcl EXPECTED/deletemetoo/pkgIndex.tcl}
+# See comments on lsort after test safe-9.20.
test safe-13.8 {mimic the glob call by tclPkgUnknown without the special treatment that is specific to pkgIndex.tcl [Bug 2964715]} -setup {
set i [safe::interpCreate]
buildEnvironment notIndex.tcl
@@ -1625,6 +1635,7 @@ test safe-16.1 {Bug 3529949: defang ~ in paths} -setup {
} -cleanup {
safe::interpDelete $i
set env(HOME) $savedHOME
+ unset savedHOME
} -result {./~}
test safe-16.2 {Bug 3529949: defang ~user in paths} -setup {
set i [safe::interpCreate]
@@ -1634,6 +1645,7 @@ test safe-16.2 {Bug 3529949: defang ~user in paths} -setup {
"file join \[file dirname ~$user\] \[file tail ~$user\]"]
} -cleanup {
safe::interpDelete $i
+ unset user
} -result {./~USER}
test safe-16.3 {Bug 3529949: defang ~ in globs} -setup {
set syntheticHOME [makeDirectory foo]
@@ -1648,6 +1660,7 @@ test safe-16.3 {Bug 3529949: defang ~ in globs} -setup {
safe::interpDelete $i
set env(HOME) $savedHOME
removeDirectory $syntheticHOME
+ unset savedHOME syntheticHOME
} -result {}
test safe-16.4 {Bug 3529949: defang ~user in globs} -setup {
set i [safe::interpCreate]
@@ -1657,7 +1670,53 @@ test safe-16.4 {Bug 3529949: defang ~user in globs} -setup {
} -cleanup {
safe::interpDelete $i
} -result {}
-
+test safe-16.5 {Bug 3529949: defang ~ in paths used by AliasGlob (1)} -setup {
+ set savedHOME $env(HOME)
+ set env(HOME) /foo/bar
+ set i [safe::interpCreate]
+} -body {
+ $i eval {
+ set d [format %c 126]
+ file join {$p(:0:)} $d
+ }
+} -cleanup {
+ safe::interpDelete $i
+ set env(HOME) $savedHOME
+ unset savedHOME
+} -result {~}
+test safe-16.6 {Bug 3529949: defang ~ in paths used by AliasGlob (2)} -setup {
+ set savedHOME $env(HOME)
+ set env(HOME) /foo/bar
+ set i [safe::interpCreate]
+} -body {
+ $i eval {
+ set d [format %c 126]
+ file join {$p(:0:)/foo/bar} $d
+ }
+} -cleanup {
+ safe::interpDelete $i
+ set env(HOME) $savedHOME
+ unset savedHOME
+} -result {~}
+test safe-16.7 {Bug 3529949: defang ~user in paths used by AliasGlob (1)} -setup {
+ set i [safe::interpCreate]
+ set user $tcl_platform(user)
+} -body {
+ string map [list $user USER] [$i eval [list file join {$p(:0:)} ~$user]]
+} -cleanup {
+ safe::interpDelete $i
+ unset user
+} -result {~USER}
+test safe-16.8 {Bug 3529949: defang ~user in paths used by AliasGlob (2)} -setup {
+ set i [safe::interpCreate]
+ set user $tcl_platform(user)
+} -body {
+ string map [list $user USER] [$i eval [list file join {$p(:0:)/foo/bar} ~$user]]
+} -cleanup {
+ safe::interpDelete $i
+ unset user
+} -result {~USER}
+
### 17. The first element in a slave's ::auto_path and access path must be [info library].
test safe-17.1 {Check that first element of slave auto_path (and access path) is Tcl Library} -setup {
@@ -1897,10 +1956,9 @@ test safe-19.2 {Check that each directory of the module path is a valid token} -
} -cleanup {
safe::interpDelete $i
} -result {}
-
-set ::auto_path $saveAutoPath
-unset saveAutoPath TestsDir PathMapp
+set ::auto_path $SaveAutoPath
+unset SaveAutoPath TestsDir PathMapp
rename mapList {}
rename mapAndSortList {}