-- cgit v0.12 From 0d59960edfba62674a912819c0328b91a02beb29 Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 13 Jul 2020 11:22:37 +0000 Subject: Add example files for use in tests/safe.test; add tests of the files themselves. --- tests/auto0/auto1/file1.tcl | 3 + tests/auto0/auto1/package1.tcl | 5 ++ tests/auto0/auto1/pkgIndex.tcl | 11 +++ tests/auto0/auto1/tclIndex | 9 +++ tests/auto0/auto2/file2.tcl | 3 + tests/auto0/auto2/package2.tcl | 5 ++ tests/auto0/auto2/pkgIndex.tcl | 11 +++ tests/auto0/auto2/tclIndex | 9 +++ tests/auto0/modules/mod1/test1-1.0.tm | 5 ++ tests/auto0/modules/mod2/test2-2.0.tm | 5 ++ tests/auto0/modules/test0-0.5.tm | 5 ++ tests/safe.test | 123 ++++++++++++++++++++++++++++++++++ 12 files changed, 194 insertions(+) create mode 100644 tests/auto0/auto1/file1.tcl create mode 100644 tests/auto0/auto1/package1.tcl create mode 100644 tests/auto0/auto1/pkgIndex.tcl create mode 100644 tests/auto0/auto1/tclIndex create mode 100644 tests/auto0/auto2/file2.tcl create mode 100644 tests/auto0/auto2/package2.tcl create mode 100644 tests/auto0/auto2/pkgIndex.tcl create mode 100644 tests/auto0/auto2/tclIndex create mode 100644 tests/auto0/modules/mod1/test1-1.0.tm create mode 100644 tests/auto0/modules/mod2/test2-2.0.tm create mode 100644 tests/auto0/modules/test0-0.5.tm diff --git a/tests/auto0/auto1/file1.tcl b/tests/auto0/auto1/file1.tcl new file mode 100644 index 0000000..bd8b92b --- /dev/null +++ b/tests/auto0/auto1/file1.tcl @@ -0,0 +1,3 @@ +proc report1 {args} { + return ok1 +} diff --git a/tests/auto0/auto1/package1.tcl b/tests/auto0/auto1/package1.tcl new file mode 100644 index 0000000..32d7c56 --- /dev/null +++ b/tests/auto0/auto1/package1.tcl @@ -0,0 +1,5 @@ +proc HeresPackage1 {args} { + return OK1 +} + +package provide SafeTestPackage1 1.2.3 diff --git a/tests/auto0/auto1/pkgIndex.tcl b/tests/auto0/auto1/pkgIndex.tcl new file mode 100644 index 0000000..babb6d5 --- /dev/null +++ b/tests/auto0/auto1/pkgIndex.tcl @@ -0,0 +1,11 @@ +# Tcl package index file, version 1.1 +# This file is generated by the "pkg_mkIndex" command +# and sourced either when an application starts up or +# by a "package unknown" script. It invokes the +# "package ifneeded" command to set up package-related +# information so that packages will be loaded automatically +# in response to "package require" commands. When this +# script is sourced, the variable $dir must contain the +# full path name of this file's directory. + +package ifneeded SafeTestPackage1 1.2.3 [list source [file join $dir package1.tcl]] diff --git a/tests/auto0/auto1/tclIndex b/tests/auto0/auto1/tclIndex new file mode 100644 index 0000000..bbfa6d4 --- /dev/null +++ b/tests/auto0/auto1/tclIndex @@ -0,0 +1,9 @@ +# Tcl autoload index file, version 2.0 +# This file is generated by the "auto_mkindex" command +# and sourced to set up indexing information for one or +# more commands. Typically each line is a command that +# sets an element in the auto_index array, where the +# element name is the name of a command and the value is +# a script that loads the command. + +set auto_index(report1) [list source [file join $dir file1.tcl]] diff --git a/tests/auto0/auto2/file2.tcl b/tests/auto0/auto2/file2.tcl new file mode 100644 index 0000000..5bc622f --- /dev/null +++ b/tests/auto0/auto2/file2.tcl @@ -0,0 +1,3 @@ +proc report2 {args} { + return ok2 +} diff --git a/tests/auto0/auto2/package2.tcl b/tests/auto0/auto2/package2.tcl new file mode 100644 index 0000000..61774df --- /dev/null +++ b/tests/auto0/auto2/package2.tcl @@ -0,0 +1,5 @@ +proc HeresPackage2 {args} { + return OK2 +} + +package provide SafeTestPackage2 2.3.4 diff --git a/tests/auto0/auto2/pkgIndex.tcl b/tests/auto0/auto2/pkgIndex.tcl new file mode 100644 index 0000000..1022691 --- /dev/null +++ b/tests/auto0/auto2/pkgIndex.tcl @@ -0,0 +1,11 @@ +# Tcl package index file, version 1.1 +# This file is generated by the "pkg_mkIndex" command +# and sourced either when an application starts up or +# by a "package unknown" script. It invokes the +# "package ifneeded" command to set up package-related +# information so that packages will be loaded automatically +# in response to "package require" commands. When this +# script is sourced, the variable $dir must contain the +# full path name of this file's directory. + +package ifneeded SafeTestPackage2 2.3.4 [list source [file join $dir package2.tcl]] diff --git a/tests/auto0/auto2/tclIndex b/tests/auto0/auto2/tclIndex new file mode 100644 index 0000000..9cd2a74 --- /dev/null +++ b/tests/auto0/auto2/tclIndex @@ -0,0 +1,9 @@ +# Tcl autoload index file, version 2.0 +# This file is generated by the "auto_mkindex" command +# and sourced to set up indexing information for one or +# more commands. Typically each line is a command that +# sets an element in the auto_index array, where the +# element name is the name of a command and the value is +# a script that loads the command. + +set auto_index(report2) [list source [file join $dir file2.tcl]] diff --git a/tests/auto0/modules/mod1/test1-1.0.tm b/tests/auto0/modules/mod1/test1-1.0.tm new file mode 100644 index 0000000..927fa6f --- /dev/null +++ b/tests/auto0/modules/mod1/test1-1.0.tm @@ -0,0 +1,5 @@ +namespace eval mod1::test1 {} + +proc mod1::test1::try1 args { + return res1 +} diff --git a/tests/auto0/modules/mod2/test2-2.0.tm b/tests/auto0/modules/mod2/test2-2.0.tm new file mode 100644 index 0000000..b5cd45b --- /dev/null +++ b/tests/auto0/modules/mod2/test2-2.0.tm @@ -0,0 +1,5 @@ +namespace eval mod2::test2 {} + +proc mod2::test2::try2 args { + return res2 +} diff --git a/tests/auto0/modules/test0-0.5.tm b/tests/auto0/modules/test0-0.5.tm new file mode 100644 index 0000000..19f3613 --- /dev/null +++ b/tests/auto0/modules/test0-0.5.tm @@ -0,0 +1,5 @@ +namespace eval test0 {} + +proc test0::try0 args { + return res0 +} diff --git a/tests/safe.test b/tests/safe.test index 11ad2a9..71fe0fb 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -24,6 +24,8 @@ foreach i [interp slaves] { set saveAutoPath $::auto_path set ::auto_path [info library] +set TestsDir [file normalize [file dirname [info script]]] + # Force actual loading of the safe package because we use un exported (and # thus un-autoindexed) APIs in this test result arguments: catch {safe::interpConfigure} @@ -179,6 +181,126 @@ test safe-6.3 {test safe interpreters knowledge of the world} { # More test should be added to check that hostname, nameofexecutable, aren't # leaking infos, but they still do... +# Tests 7.0* test the example files before using them to test safe interpreters. + +test safe-7.0a {example tclIndex commands, test in master interpreter} -setup { + set tmpAutoPath $::auto_path + lappend ::auto_path [file join $TestsDir auto0 auto1] [file join $TestsDir auto0 auto2] +} -body { + # Try to load the commands. + set code3 [catch report1 msg3] + set code4 [catch report2 msg4] + list $code3 $msg3 $code4 $msg4 +} -cleanup { + catch {rename report1 {}} + catch {rename report2 {}} + 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] +} -body { + # Try to load the commands. + set code3 [catch report1 msg3] + set code4 [catch report2 msg4] + list $code3 $msg3 $code4 $msg4 +} -cleanup { + catch {rename report1 {}} + catch {rename report2 {}} + 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] +} -body { + # Try to load the packages and run a command from each one. + set code3 [catch {package require SafeTestPackage1} msg3] + 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 + catch {package forget SafeTestPackage1} + catch {package forget SafeTestPackage2} + 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] \ + [file join $TestsDir auto0 auto2] +} -body { + # Try to load the packages and run a command from each one. + set code3 [catch {package require SafeTestPackage1} msg3] + 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 + catch {package forget SafeTestPackage1} + catch {package forget SafeTestPackage2} + 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 { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + # Try to load the modules and run a command from each one. + set code0 [catch {package require test0} msg0] + set code1 [catch {package require mod1::test1} msg1] + set code2 [catch {package require mod2::test2} msg2] + 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] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + catch {package forget test0} + catch {package forget mod1::test1} + catch {package forget mod2::test2} + 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 { + # Try to load the modules and run a command from each one. + set code0 [catch {package require test0} msg0] + set code1 [catch {package require mod1::test1} msg1] + set code2 [catch {package require mod2::test2} msg2] + 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] + catch {package forget test0} + catch {package forget mod1::test1} + catch {package forget mod2::test2} + catch {namespace delete ::test0} + catch {namespace delete ::mod1} +} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2} + # high level general test test safe-7.1 {tests that everything works at high level} -body { set i [safe::interpCreate] @@ -833,6 +955,7 @@ test safe-16.4 {Bug 3529949: defang ~user in globs} -setup { } -result {} set ::auto_path $saveAutoPath +unset saveAutoPath TestsDir # cleanup ::tcltest::cleanupTests return -- cgit v0.12 From 2c1750c78f0c5c36008d4043f099ef2485d96de4 Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 13 Jul 2020 11:43:52 +0000 Subject: Add new tests to tests/safe.test. --- tests/safe.test | 544 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 544 insertions(+) diff --git a/tests/safe.test b/tests/safe.test index 71fe0fb..3ff9e62 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -527,6 +527,550 @@ test safe-9.6 {interpConfigure widget like behaviour} -body { safe::interpConfigure $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.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} \ + ] + + safe::interpConfigure $i -accessPath /foo/bar + set a [safe::interpConfigure $i] + set b [safe::interpConfigure $i -aCCess] + set c [safe::interpConfigure $i -nested] + set d [safe::interpConfigure $i -statics] + set e [safe::interpConfigure $i -DEL] + safe::interpConfigure $i -accessPath /blah -statics 1 + set f [safe::interpConfigure $i] + safe::interpConfigure $i -deleteHook toto -nosta -nested 0 + set g [safe::interpConfigure $i] + + 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}} + +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 \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]]] + + # Inspect. + set confA [safe::interpConfigure $i] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Load auto_load data. + interp eval $i {catch nonExistentCommand} + + # Load and run the commands. + # This guarantees the test will pass even if the tokens are swapped. + set code1 [catch {interp eval $i {report1}} msg1] + set code2 [catch {interp eval $i {report2}} msg2] + + # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto2] \ + [file join $TestsDir auto0 auto1]] + + # Inspect. + set confB [safe::interpConfigure $i] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Run the commands. + set code3 [catch {interp eval $i {report1}} msg3] + set code4 [catch {interp eval $i {report2}} msg4] + + list $path1 $path2 $path3 $path4 $code3 $msg3 $code4 $msg4 $confA $confB +} -cleanup { + safe::interpDelete $i +} -match glob -result "{\$p(:1:)} {\$p(:2:)} {\$p(:2:)} {\$p(:1:)} 0 ok1 0 ok2\ + {-accessPath {[list $tcl_library $TestsDir/auto0/auto1 $TestsDir/auto0/auto2]*}\ + -statics 1 -nested 0 -deleteHook {}}\ + {-accessPath {[list $tcl_library $TestsDir/auto0/auto2 $TestsDir/auto0/auto1]*}\ + -statics 1 -nested 0 -deleteHook {}}" + +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 \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]]] + + # Inspect. + set confA [safe::interpConfigure $i] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Load auto_load data. + interp eval $i {catch nonExistentCommand} + + # Do not load the commands. With the tokens swapped, the test + # will pass only if the Safe Base has called auto_reset. + + # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto2] \ + [file join $TestsDir auto0 auto1]] + + # Inspect. + set confB [safe::interpConfigure $i] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Load and run the commands. + set code3 [catch {interp eval $i {report1}} msg3] + set code4 [catch {interp eval $i {report2}} msg4] + + list $path1 $path2 $path3 $path4 $code3 $msg3 $code4 $msg4 $confA $confB +} -cleanup { + safe::interpDelete $i +} -match glob -result "{\$p(:1:)} {\$p(:2:)} {\$p(:2:)} {\$p(:1:)} 0 ok1 0 ok2\ + {-accessPath {[list $tcl_library $TestsDir/auto0/auto1 $TestsDir/auto0/auto2]*}\ + -statics 1 -nested 0 -deleteHook {}}\ + {-accessPath {[list $tcl_library $TestsDir/auto0/auto2 $TestsDir/auto0/auto1]*}\ + -statics 1 -nested 0 -deleteHook {}}" + +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. + set i [safe::interpCreate -accessPath [list $tcl_library \ + [file join $TestsDir auto0] \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]]] + + # Inspect. + set confA [safe::interpConfigure $i] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Rearrange access path. Swap tokens {$p(:2:)} and {$p(:3:)}. + # This would have no effect because the records in Pkg of these directories + # were from access as children of {$p(:1:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0] \ + [file join $TestsDir auto0 auto2] \ + [file join $TestsDir auto0 auto1]] + + # Inspect. + set confB [safe::interpConfigure $i] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Try to load the packages and run a command from each one. + set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3] + set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4] + 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 $confA $confB \ + $code5 $msg5 $code6 $msg6 + +} -cleanup { + safe::interpDelete $i +} -match glob -result "{\$p(:2:)} {\$p(:3:)} {\$p(:3:)} {\$p(:2:)} 0 1.2.3 0 2.3.4\ + {-accessPath {[list $tcl_library $TestsDir/auto0 $TestsDir/auto0/auto1 $TestsDir/auto0/auto2]*}\ + -statics 1 -nested 0 -deleteHook {}}\ + {-accessPath {[list $tcl_library $TestsDir/auto0 $TestsDir/auto0/auto2 $TestsDir/auto0/auto1]*}\ + -statics 1 -nested 0 -deleteHook {}}\ + 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 path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto2] \ + [file join $TestsDir auto0 auto1]] + + # Inspect. + set confB [safe::interpConfigure $i] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Try to load the packages and run a command from each one. + set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3] + set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4] + 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 $confA $confB \ + $code5 $msg5 $code6 $msg6 +} -cleanup { + safe::interpDelete $i +} -match glob -result "{\$p(:1:)} {\$p(:2:)} {\$p(:2:)} {\$p(:1:)} 0 1.2.3 0 2.3.4\ + {-accessPath {[list $tcl_library $TestsDir/auto0/auto1 $TestsDir/auto0/auto2]*}\ + -statics 1 -nested 0 -deleteHook {}}\ + {-accessPath {[list $tcl_library $TestsDir/auto0/auto2 $TestsDir/auto0/auto1]*}\ + -statics 1 -nested 0 -deleteHook {}}\ + 0 OK1 0 OK2" + +test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed} -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 path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Load pkgIndex.tcl data. + catch {interp eval $i {package require NOEXIST}} + + # Limit access path. Remove tokens {$p(:1:)} and {$p(:2:)}. + safe::interpConfigure $i -accessPath [list $tcl_library] + + # Inspect. + set confB [safe::interpConfigure $i] + set code4 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]} path4] + set code5 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]} path5] + + # Try to load the packages. + 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 $msg3 $code6 $msg6 $confA $confB +} -cleanup { + safe::interpDelete $i +} -match glob -result "{\$p(:1:)} {\$p(:2:)} 1 {* not found in access path}\ + 1 {* not found in access path} 1 {*} 1 {*}\ + {-accessPath {[list $tcl_library $TestsDir/auto0/auto1 $TestsDir/auto0/auto2]*}\ + -statics 1 -nested 0 -deleteHook {}}\ + {-accessPath {[list $tcl_library]*} -statics 1 -nested 0 -deleteHook {}}" + +test safe-9.20 {check module loading} -setup { + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list $path0 $path1 $path2 -- $modsA -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $confA -- $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i +} -match glob -result "{\$p(:1:)} {\$p(:2:)} {\$p(:3:)} -- {{\$p(:1:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {-accessPath {[list $tcl_library $TestsDir/auto0/modules \ + $TestsDir/auto0/modules/mod1 \ + $TestsDir/auto0/modules/mod2]*}\ + -statics 1 -nested 0 -deleteHook {}} --\ + res0 res1 res2" + +test safe-9.21 {interpConfigure change the access path; check module loading; stale data case 1} -setup { + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] + + # Inspect. + set confB [safe::interpConfigure $i] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Load pkg data. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list $path0 $path1 $path2 -- $modsA -- $path3 $path4 $path5 -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $confA -- $confB -- \ + $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i +} -match glob -result "{\$p(:1:)} {\$p(:2:)} {\$p(:3:)} -- {{\$p(:1:)}} --\ + {\$p(:3:)} {\$p(:4:)} {\$p(:5:)} -- {{\$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {-accessPath {[list $tcl_library \ + $TestsDir/auto0/modules \ + $TestsDir/auto0/modules/mod1 \ + $TestsDir/auto0/modules/mod2]}\ + -statics 1 -nested 0 -deleteHook {}} --\ + {-accessPath {[list $tcl_library \ + $TestsDir/auto0/auto1 \ + $TestsDir/auto0/auto2 \ + $TestsDir/auto0/modules \ + $TestsDir/auto0/modules/mod1 \ + $TestsDir/auto0/modules/mod2]}\ + -statics 1 -nested 0 -deleteHook {}} --\ + res0 res1 res2" + +test safe-9.22 {interpConfigure change the access path; check module loading; stale data case 0} -setup { + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] + + # Inspect. + set confB [safe::interpConfigure $i] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list $path0 $path1 $path2 -- $modsA -- $path3 $path4 $path5 -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $confA -- $confB -- \ + $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i +} -match glob -result "{\$p(:1:)} {\$p(:2:)} {\$p(:3:)} -- {{\$p(:1:)}} --\ + {\$p(:3:)} {\$p(:4:)} {\$p(:5:)} -- {{\$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {-accessPath {[list $tcl_library \ + $TestsDir/auto0/modules \ + $TestsDir/auto0/modules/mod1 \ + $TestsDir/auto0/modules/mod2]}\ + -statics 1 -nested 0 -deleteHook {}} --\ + {-accessPath {[list $tcl_library \ + $TestsDir/auto0/auto1 \ + $TestsDir/auto0/auto2 \ + $TestsDir/auto0/modules \ + $TestsDir/auto0/modules/mod1 \ + $TestsDir/auto0/modules/mod2]}\ + -statics 1 -nested 0 -deleteHook {}} --\ + res0 res1 res2" + +test safe-9.23 {interpConfigure change the access path; check module loading; stale data case 3} -setup { + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Force the interpreter to acquire pkg data which will soon become stale. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] + + # Inspect. + set confB [safe::interpConfigure $i] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Refresh stale pkg data. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list $path0 $path1 $path2 -- $modsA -- $path3 $path4 $path5 -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $confA -- $confB -- \ + $out0 $out1 $out2 + +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i +} -match glob -result "{\$p(:1:)} {\$p(:2:)} {\$p(:3:)} -- {{\$p(:1:)}} --\ + {\$p(:3:)} {\$p(:4:)} {\$p(:5:)} -- {{\$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {-accessPath {[list $tcl_library \ + $TestsDir/auto0/modules \ + $TestsDir/auto0/modules/mod1 \ + $TestsDir/auto0/modules/mod2]}\ + -statics 1 -nested 0 -deleteHook {}} --\ + {-accessPath {[list $tcl_library \ + $TestsDir/auto0/auto1 \ + $TestsDir/auto0/auto2 \ + $TestsDir/auto0/modules \ + $TestsDir/auto0/modules/mod1 \ + $TestsDir/auto0/modules/mod2]}\ + -statics 1 -nested 0 -deleteHook {}} --\ + res0 res1 res2" + +test safe-9.24 {interpConfigure change the access path; check module loading; stale data case 2 (worst case)} -setup { + set oldTm [tcl::tm::path list] + foreach path $oldTm { + tcl::tm::path remove $path + } + tcl::tm::path add [file join $TestsDir auto0 modules] +} -body { + set i [safe::interpCreate -accessPath [list $tcl_library]] + + # Inspect. + set confA [safe::interpConfigure $i] + set modsA [interp eval $i {tcl::tm::path list}] + set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Force the interpreter to acquire pkg data which will soon become stale. + catch {interp eval $i {package require NOEXIST}} + catch {interp eval $i {package require mod1::NOEXIST}} + catch {interp eval $i {package require mod2::NOEXIST}} + + # Add to access path. + # This injects more tokens, pushing modules to higher token numbers. + safe::interpConfigure $i -accessPath [list $tcl_library \ + [file join $TestsDir auto0 auto1] \ + [file join $TestsDir auto0 auto2]] + + # Inspect. + set confB [safe::interpConfigure $i] + set modsB [interp eval $i {tcl::tm::path list}] + set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] + set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] + set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]] + + # Try to load the packages and run a command from each one. + set code0 [catch {interp eval $i {package require test0}} msg0] + set code1 [catch {interp eval $i {package require mod1::test1}} msg1] + set code2 [catch {interp eval $i {package require mod2::test2}} msg2] + set out0 [interp eval $i {test0::try0}] + set out1 [interp eval $i {mod1::test1::try1}] + set out2 [interp eval $i {mod2::test2::try2}] + + list $path0 $path1 $path2 -- $modsA -- $path3 $path4 $path5 -- $modsB -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $confA -- $confB -- \ + $out0 $out1 $out2 +} -cleanup { + tcl::tm::path remove [file join $TestsDir auto0 modules] + foreach path [lreverse $oldTm] { + tcl::tm::path add $path + } + safe::interpDelete $i +} -match glob -result "{\$p(:1:)} {\$p(:2:)} {\$p(:3:)} -- {{\$p(:1:)}} --\ + {\$p(:3:)} {\$p(:4:)} {\$p(:5:)} -- {{\$p(:3:)}} --\ + 0 0.5 0 1.0 0 2.0 --\ + {-accessPath {[list $tcl_library \ + $TestsDir/auto0/modules \ + $TestsDir/auto0/modules/mod1 \ + $TestsDir/auto0/modules/mod2]}\ + -statics 1 -nested 0 -deleteHook {}} --\ + {-accessPath {[list $tcl_library \ + $TestsDir/auto0/auto1 \ + $TestsDir/auto0/auto2 \ + $TestsDir/auto0/modules \ + $TestsDir/auto0/modules/mod1 \ + $TestsDir/auto0/modules/mod2]}\ + -statics 1 -nested 0 -deleteHook {}} --\ + res0 res1 res2" + + catch {teststaticpkg Safepkg1 0 0} test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup { set i [safe::interpCreate] -- cgit v0.12 From c256107a5c50a4ffa13d226f245f25cf4ccc311f Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 13 Jul 2020 11:49:46 +0000 Subject: Bugfix in library/safe.tcl for doreset (auto_reset); pass test safe-9.9 --- library/safe.tcl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/library/safe.tcl b/library/safe.tcl index 3429b9e..7ed6b94 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -192,10 +192,10 @@ proc ::safe::interpConfigure {args} { # Get the current (and not the default) values of whatever has # not been given: if {![::tcl::OptProcArgGiven -accessPath]} { - set doreset 1 + set doreset 0 set accessPath $state(access_path) } else { - set doreset 0 + set doreset 1 } if { ![::tcl::OptProcArgGiven -statics] -- cgit v0.12 From 9c9af976ae17ba173df40300467589554956e8f2 Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 13 Jul 2020 12:09:47 +0000 Subject: Bugfix in library/safe.tcl - when auto_reset, also reload pkgIndex.tcl data; pass tests safe-9.10, safe-9.11 --- library/safe.tcl | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/library/safe.tcl b/library/safe.tcl index 7ed6b94..deefa33 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -225,6 +225,14 @@ proc ::safe::interpConfigure {args} { } else { Log $slave "successful auto_reset" NOTICE } + # Wherever possible, refresh package data. + # - Ideally [package ifneeded $pkg $ver {}] would clear the + # stale data from the interpreter, but instead it sets a + # nonsense empty script. + # - We cannot purge stale package data, but we can overwrite + # it where we have fresh data. Any remaining stale data will + # do no harm but the error messages may be cryptic. + ::interp eval $slave [list catch {package require NOEXIST}] } } } -- cgit v0.12 From af4b36c13d6d8cbcdf5798b5b12dd996b484d8a8 Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 13 Jul 2020 12:13:07 +0000 Subject: Bugfix in library/safe.tcl - remove impossible error message in safe::interpFindInAccessPath; pass test safe-9.12 --- library/safe.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/safe.tcl b/library/safe.tcl index deefa33..838f65f 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -404,7 +404,7 @@ proc ::safe::interpFindInAccessPath {slave path} { namespace upvar ::safe S$slave state if {![dict exists $state(access_path,remap) $path]} { - return -code error "$path not found in access path $access_path" + return -code error "$path not found in access path" } return [dict get $state(access_path,remap) $path] -- cgit v0.12 From cca23e5286ec6f14dd7c62275cc409419f2a6d3c Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 13 Jul 2020 12:25:10 +0000 Subject: Bugfix in library/safe.tcl - only add tm roots to tcl::tm::list; pass test safe-9.20 --- library/safe.tcl | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/library/safe.tcl b/library/safe.tcl index 838f65f..d31ca63 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -352,6 +352,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { } set morepaths [::tcl::tm::list] + set firstpass 1 while {[llength $morepaths]} { set addpaths $morepaths set morepaths {} @@ -360,6 +361,12 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { # Prevent the addition of dirs on the tm list to the # result if they are already known. if {[dict exists $remap_access_path $dir]} { + if {$firstpass} { + # $dir is in [::tcl::tm::list] and belongs in the slave_tm_path. + # Later passes handle subdirectories, which belong in the + # access path but not in the module path. + lappend slave_tm_path [dict get $remap_access_path $dir] + } continue } @@ -369,7 +376,12 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { lappend map_access_path $token $dir lappend remap_access_path $dir $token lappend norm_access_path [file normalize $dir] - lappend slave_tm_path $token + if {$firstpass} { + # $dir is in [::tcl::tm::list] and belongs in the slave_tm_path. + # Later passes handle subdirectories, which belong in the + # access path but not in the module path. + lappend slave_tm_path $token + } incr i # [Bug 2854929] @@ -380,6 +392,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { # subdirectories. lappend morepaths {*}[glob -nocomplain -directory $dir -type d *] } + set firstpass 0 } set state(access_path) $access_path -- cgit v0.12 From f0a97b5c716346e60173644010e1d201bea8e690 Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 13 Jul 2020 12:32:08 +0000 Subject: Bugfix in library/safe.tcl - interpConfigure use revised value of tcl::tm::list; pass tests safe-9.21, safe-9.22 --- library/safe.tcl | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/library/safe.tcl b/library/safe.tcl index d31ca63..4d22cbe 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -225,6 +225,14 @@ proc ::safe::interpConfigure {args} { } else { Log $slave "successful auto_reset" NOTICE } + + # Sync the paths used to search for Tcl modules. + ::interp eval $slave {tcl::tm::path remove {*}[tcl::tm::list]} + if {[llength $state(tm_path_slave)] > 0} { + ::interp eval $slave [list \ + ::tcl::tm::add {*}[lreverse $state(tm_path_slave)]] + } + # Wherever possible, refresh package data. # - Ideally [package ifneeded $pkg $ver {}] would clear the # stale data from the interpreter, but instead it sets a -- cgit v0.12 From 12ba446acbcd70856603aeeffb90fc425be58e02 Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 13 Jul 2020 12:37:16 +0000 Subject: Bugfix in library/tm.tcl - in a safe interp ::tcl::tm::UnknownHandler should always use the freshest "package ifneeded"; pass test safe-9.23 --- library/tm.tcl | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/library/tm.tcl b/library/tm.tcl index 1802bb9..3861532 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -238,12 +238,16 @@ proc ::tcl::tm::UnknownHandler {original name args} { continue } - if {[package ifneeded $pkgname $pkgversion] ne {}} { + if { ([package ifneeded $pkgname $pkgversion] ne {}) + && (![interp issafe]) + } { # There's already a provide script registered for # this version of this package. Since all units of # code claiming to be the same version of the same # package ought to be identical, just stick with # the one we already have. + # This does not apply to Safe Base interpreters because + # the token-to-directory mapping may have changed. continue } -- cgit v0.12 From 4c326aa381e14ad6cdef2060e7f0a6328b970699 Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 13 Jul 2020 12:52:53 +0000 Subject: Bugfix in library/safe.tcl - when auto_reset, also reload module data; pass test safe-9.24 --- library/safe.tcl | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/library/safe.tcl b/library/safe.tcl index 4d22cbe..30b045e 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -217,7 +217,7 @@ proc ::safe::interpConfigure {args} { set deleteHook $state(cleanupHook) } # we can now reconfigure : - InterpSetConfig $slave $accessPath $statics $nested $deleteHook + set slave_tm_rel [InterpSetConfig $slave $accessPath $statics $nested $deleteHook] # auto_reset the slave (to completly synch the new access_path) if {$doreset} { if {[catch {::interp eval $slave {auto_reset}} msg]} { @@ -233,7 +233,7 @@ proc ::safe::interpConfigure {args} { ::tcl::tm::add {*}[lreverse $state(tm_path_slave)]] } - # Wherever possible, refresh package data. + # Wherever possible, refresh package/module data. # - Ideally [package ifneeded $pkg $ver {}] would clear the # stale data from the interpreter, but instead it sets a # nonsense empty script. @@ -241,6 +241,10 @@ proc ::safe::interpConfigure {args} { # it where we have fresh data. Any remaining stale data will # do no harm but the error messages may be cryptic. ::interp eval $slave [list catch {package require NOEXIST}] + foreach rel $slave_tm_rel { + set cmd [list package require [string map {/ ::} $rel]::NOEXIST] + ::interp eval $slave [list catch $cmd] + } } } } @@ -348,6 +352,8 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { set map_access_path {} set remap_access_path {} set slave_tm_path {} + set slave_tm_roots {} + set slave_tm_rel {} set i 0 foreach dir $access_path { @@ -374,6 +380,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { # Later passes handle subdirectories, which belong in the # access path but not in the module path. lappend slave_tm_path [dict get $remap_access_path $dir] + lappend slave_tm_roots [file normalize $dir] [file normalize $dir] } continue } @@ -389,6 +396,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { # Later passes handle subdirectories, which belong in the # access path but not in the module path. lappend slave_tm_path $token + lappend slave_tm_roots [file normalize $dir] [file normalize $dir] } incr i @@ -399,6 +407,14 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { # 'platform/shell-X.tm', i.e arbitrarily deep # subdirectories. lappend morepaths {*}[glob -nocomplain -directory $dir -type d *] + foreach sub [glob -nocomplain -directory $dir -type d *] { + lappend slave_tm_roots [file normalize $sub] [dict get $slave_tm_roots $dir] + set lenny [string length [dict get $slave_tm_roots $dir]] + set relpath [string range [file normalize $sub] $lenny+1 end] + if {$relpath ni $slave_tm_rel} { + lappend slave_tm_rel $relpath + } + } } set firstpass 0 } @@ -414,6 +430,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { set state(cleanupHook) $deletehook SyncAccessPath $slave + return $slave_tm_rel } # -- cgit v0.12 From 7169e0abe0053715354bdb1f7e2ecec9199e9691 Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 13 Jul 2020 14:55:28 +0000 Subject: Add tests to tests/safe.test --- tests/safe.test | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 71 insertions(+), 2 deletions(-) diff --git a/tests/safe.test b/tests/safe.test index 3ff9e62..c70d9b1 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -9,6 +9,7 @@ # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. +# PURGE SyncExists AutoPathSync package require Tcl 8.5- @@ -302,7 +303,25 @@ test safe-7.0f {example modules packages, test in master interpreter, append to } -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2} # high level general test -test safe-7.1 {tests that everything works at high level} -body { +# Use example packages not http1.0 +test safe-7.1 {tests that everything works at high level} -setup { + set tmpAutoPath $::auto_path + lappend ::auto_path [file join $TestsDir auto0] + set i [safe::interpCreate] + set ::auto_path $tmpAutoPath +} -body { + # no error shall occur: + # (because the default access_path shall include 1st level sub dirs so + # package require in a slave works like in the master) + set v [interp eval $i {package require SafeTestPackage1}] + # no error shall occur: + interp eval $i {HeresPackage1} + set v +} -cleanup { + safe::interpDelete $i +} -match glob -result 1.2.3 +# high level general test +test safe-7.1http {tests that everything works at high level, uses http 2} -body { set i [safe::interpCreate] # no error shall occur: # (because the default access_path shall include 1st level sub dirs so @@ -313,7 +332,27 @@ test safe-7.1 {tests that everything works at high level} -body { safe::interpDelete $i set v } -match glob -result 2.* -test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body { +test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -setup { +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p* (not p1 if master has a module path) + set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] + # should add as p* (not p2 if master has a module path) + set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]] + # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level + # provided deep path) + list $token1 $token2 $token3 \ + [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg \ + [safe::interpConfigure $i]\ + [safe::interpDelete $i] +} -cleanup { +} -match glob -result "{\$p(:0:)} {\$p(:*:)} {\$p(:*:)} 1\ + {can't find package SafeTestPackage1}\ + {-accessPath {[list $tcl_library */dummy/unixlike/test/path $TestsDir/auto0]}\ + -statics 0 -nested 1 -deleteHook {}} {}" +test safe-7.2http {tests specific path and interpFind/AddToAccessPath, uses http1.0} -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) set token1 [safe::interpAddToAccessPath $i [info library]] @@ -331,6 +370,36 @@ test safe-7.3 {check that safe subinterpreters work} { set j [safe::interpCreate [list $i x]] list [interp eval $j {join {o k} ""}] [safe::interpDelete $i] [interp exists $j] } {ok {} 0} +test safe-7.4 {tests specific path and positive search} -setup { +} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p* (not p1 if master has a module path) + set token2 [safe::interpAddToAccessPath $i [file join $TestsDir auto0 auto1]] + # this time, unlike test safe-7.2, SafeTestPackage1 should be found + list $token1 $token2 \ + [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg \ + [safe::interpConfigure $i]\ + [safe::interpDelete $i] + # Note that the glob match elides directories (those from the module path) + # other than the first and last in the access path. +} -cleanup { +} -match glob -result "{\$p(:0:)} {\$p(:*:)} 0 1.2.3\ + {-accessPath {[list $tcl_library * $TestsDir/auto0/auto1]}\ + -statics 0 -nested 1 -deleteHook {}} {}" +test safe-7.4http {tests specific path and positive search, uses http1.0} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p1 + set token2 [safe::interpAddToAccessPath $i [file join [info library] http1.0]] + # this time, unlike test safe-7.2, http should be found + list $token1 $token2 \ + [catch {interp eval $i {package require http 1}} msg] $msg \ + [safe::interpConfigure $i]\ + [safe::interpDelete $i] +} -match glob -result "{\$p(:0:)} {\$p(:*:)} 0 1.0 {-accessPath {[list $tcl_library *$tcl_library/http1.0]} -statics 0 -nested 1 -deleteHook {}} {}" # test source control on file name set i "a" -- cgit v0.12 From 26cf086c2c3bbb88a608e5c24767c065f5763d8a Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 13 Jul 2020 14:57:44 +0000 Subject: Comments only. --- tests/safe.test | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/safe.test b/tests/safe.test index c70d9b1..0f40c36 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -9,7 +9,6 @@ # # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -# PURGE SyncExists AutoPathSync package require Tcl 8.5- -- cgit v0.12 From c14dbae8ad115c63cccc32ca0fee7a5c355edbe5 Mon Sep 17 00:00:00 2001 From: kjnash Date: Wed, 15 Jul 2020 13:22:54 +0000 Subject: Bugfix in library/safe.tcl - when deleting a safe interpreter, delete its sub-interpreters cleanly; pass revised test safe-7.3 --- library/safe.tcl | 11 +++++++++++ tests/safe.test | 12 ++++++++++-- 2 files changed, 21 insertions(+), 2 deletions(-) diff --git a/library/safe.tcl b/library/safe.tcl index 30b045e..68d4b21 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -593,6 +593,17 @@ proc ::safe::interpDelete {slave} { namespace upvar ::safe S$slave state + # When an interpreter is deleted with [interp delete], any sub-interpreters + # are deleted automatically, but this leaves behind their data in the Safe + # Base. To clean up properly, we call safe::interpDelete recursively on each + # Safe Base sub-interpreter, so each one is deleted cleanly and not by + # the automatic mechanism built into [interp delete]. + foreach sub [interp slaves $slave] { + if {[info exists ::safe::S[list $slave $sub]]} { + ::safe::interpDelete [list $slave $sub] + } + } + # If the slave has a cleanup hook registered, call it. Check the # existance because we might be called to delete an interp which has # not been registered with us at all diff --git a/tests/safe.test b/tests/safe.test index 0f40c36..6b55ef1 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -365,10 +365,18 @@ test safe-7.2http {tests specific path and interpFind/AddToAccessPath, uses http [safe::interpDelete $i] } -match glob -result "{\$p(:0:)} {\$p(:*:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library */dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}" test safe-7.3 {check that safe subinterpreters work} { + set g [interp slaves] + if {$g ne {}} { + append g { -- residue of an earlier test} + } + set h [info vars ::safe::S*] + if {$h ne {}} { + append h { -- residue of an earlier test} + } set i [safe::interpCreate] set j [safe::interpCreate [list $i x]] - list [interp eval $j {join {o k} ""}] [safe::interpDelete $i] [interp exists $j] -} {ok {} 0} + 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} -setup { } -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] -- cgit v0.12 From 69fdd85b744c7f463d6731dff11db373df7e33f6 Mon Sep 17 00:00:00 2001 From: kjnash Date: Wed, 15 Jul 2020 17:03:47 +0000 Subject: Bugfix in library/safe.tcl - AliasGlob passes -join to glob inappropriately; pass new test safe-13.7a --- library/safe.tcl | 6 +++++- tests/safe.test | 34 ++++++++++++++++++++++++++++++---- 2 files changed, 35 insertions(+), 5 deletions(-) diff --git a/library/safe.tcl b/library/safe.tcl index 68d4b21..82a2780 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -769,11 +769,15 @@ proc ::safe::AliasGlob {slave args} { while {$at < [llength $args]} { switch -glob -- [set opt [lindex $args $at]] { - -nocomplain - -- - -join - -tails { + -nocomplain - -- - -tails { lappend cmd $opt set got($opt) 1 incr at } + -join { + set got($opt) 1 + incr at + } -types - -type { lappend cmd -types [lindex $args [incr at]] incr at diff --git a/tests/safe.test b/tests/safe.test index 6b55ef1..c250400 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -1354,6 +1354,15 @@ proc buildEnvironment {filename} { set testdir2 [makeDirectory deletemetoo $testdir] set testfile [makeFile {} $filename $testdir2] } +proc buildEnvironment2 {filename} { + upvar 1 testdir testdir testdir2 testdir2 testfile testfile + upvar 1 testdir3 testdir3 testfile2 testfile2 + set testdir [makeDirectory deletethisdir] + set testdir2 [makeDirectory deletemetoo $testdir] + set testfile [makeFile {} $filename $testdir2] + set testdir3 [makeDirectory deleteme $testdir] + set testfile2 [makeFile {} $filename $testdir3] +} #### New tests for Safe base glob, with patches @ Bug 2964715 test safe-13.1 {glob is restricted [Bug 2964715]} -setup { set i [safe::interpCreate] @@ -1425,7 +1434,7 @@ test safe-13.6 {as 13.4 but test silent failure when result is outside access_pa safe::interpDelete $i removeDirectory $testdir } -result {} -test safe-13.7 {mimic the glob call by tclPkgUnknown which gives a deliberate error in a safe interpreter [Bug 2964715]} -setup { +test safe-13.7 {mimic the glob call by tclPkgUnknown in a safe interpreter [Bug 2964715]} -setup { set i [safe::interpCreate] buildEnvironment pkgIndex.tcl } -body { @@ -1437,9 +1446,25 @@ test safe-13.7 {mimic the glob call by tclPkgUnknown which gives a deliberate er safe::interpDelete $i removeDirectory $testdir } -result {{EXPECTED/deletemetoo/pkgIndex.tcl}} -# Note the extra {} around the result above; that's *expected* because of the -# format of virtual path roots. -test safe-13.8 {mimic the glob call by tclPkgUnknown without the deliberate error that is specific to pkgIndex.tcl [Bug 2964715]} -setup { +# Note the extra {} around the result above; that's *expected* because the +# tokenized paths require delimitation in the list returned by glob; the +# braces remain after the token is replaced by EXPECTED. +test safe-13.7a {mimic the glob call by tclPkgUnknown in a safe interpreter with multiple subdirectories} -setup { + set i [safe::interpCreate] + buildEnvironment2 pkgIndex.tcl +} -body { + set safeTD [::safe::interpAddToAccessPath $i $testdir] + ::safe::interpAddToAccessPath $i $testdir2 + ::safe::interpAddToAccessPath $i $testdir3 + lsort [string map [list $safeTD EXPECTED] [$i eval [list \ + glob -directory $safeTD -join * pkgIndex.tcl]]] +} -cleanup { + safe::interpDelete $i + removeDirectory $testdir +} -result {EXPECTED/deleteme/pkgIndex.tcl EXPECTED/deletemetoo/pkgIndex.tcl} +# Cf safe-13.7 - this time there's no extra {} around the result; the list +# operation lsort removed it. +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 } -body { @@ -1477,6 +1502,7 @@ test safe-13.10 {as 13.8 but test silent failure when result is outside access_p removeDirectory $testdir } -result {} rename buildEnvironment {} +rename buildEnvironment2 {} #### Test for the module path test safe-14.1 {Check that module path is the same as in the master interpreter [Bug 2964715]} -setup { -- cgit v0.12 From 79214905a2153e60fdf993173f37afcc2b2e80d8 Mon Sep 17 00:00:00 2001 From: kjnash Date: Wed, 15 Jul 2020 23:11:46 +0000 Subject: Bugfix tests/safe.test. Harden tests safe-9.20 to safe-9.24 against indeterminate order of glob matches. Audit use of glob and tcl::tm in modified tests for cases with multiple matches. Simplify test comparison patterns. --- library/safe.tcl | 5 +- tests/safe.test | 307 +++++++++++++++++++++++++++---------------------------- 2 files changed, 154 insertions(+), 158 deletions(-) diff --git a/library/safe.tcl b/library/safe.tcl index 82a2780..74aee87 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -406,8 +406,9 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { # 'platform::shell', which translate into # 'platform/shell-X.tm', i.e arbitrarily deep # subdirectories. - lappend morepaths {*}[glob -nocomplain -directory $dir -type d *] - foreach sub [glob -nocomplain -directory $dir -type d *] { + set next [glob -nocomplain -directory $dir -type d *] + lappend morepaths {*}$next + foreach sub $next { lappend slave_tm_roots [file normalize $sub] [dict get $slave_tm_roots $dir] set lenny [string length [dict get $slave_tm_roots $dir]] set relpath [string range [file normalize $sub] $lenny+1 end] diff --git a/tests/safe.test b/tests/safe.test index c250400..69da9d2 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -25,8 +25,24 @@ 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] -# Force actual loading of the safe package because we use un exported (and +proc mapList {map listIn} { + set listOut {} + foreach element $listIn { + lappend listOut [string map $map $element] + } + return $listOut +} +proc mapAndSortList {map listIn} { + set listOut {} + foreach element $listIn { + lappend listOut [string map $map $element] + } + lsort $listOut +} + +# Force actual loading of the safe package because we use un-exported (and # thus un-autoindexed) APIs in this test result arguments: catch {safe::interpConfigure} @@ -340,30 +356,32 @@ test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -setup { set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] # should add as p* (not p2 if master has a module path) set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]] + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level # provided deep path) - list $token1 $token2 $token3 \ - [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg \ - [safe::interpConfigure $i]\ - [safe::interpDelete $i] + list $token1 $token2 $token3 -- \ + [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \ + $mappA -- [safe::interpDelete $i] } -cleanup { -} -match glob -result "{\$p(:0:)} {\$p(:*:)} {\$p(:*:)} 1\ - {can't find package SafeTestPackage1}\ - {-accessPath {[list $tcl_library */dummy/unixlike/test/path $TestsDir/auto0]}\ - -statics 0 -nested 1 -deleteHook {}} {}" +} -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\ + 1 {can't find package SafeTestPackage1} --\ + {TCLLIB */dummy/unixlike/test/path TESTSDIR/auto0} -- {}} test safe-7.2http {tests specific path and interpFind/AddToAccessPath, uses http1.0} -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) set token1 [safe::interpAddToAccessPath $i [info library]] # should add as p1 set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] # an error shall occur (http is not anymore in the secure 0-level # provided deep path) - list $token1 $token2 \ - [catch {interp eval $i {package require http 1}} msg] $msg \ - [safe::interpConfigure $i]\ - [safe::interpDelete $i] -} -match glob -result "{\$p(:0:)} {\$p(:*:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library */dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}" + list $token1 $token2 -- \ + [catch {interp eval $i {package require http 1}} msg] $msg -- \ + $mappA -- [safe::interpDelete $i] +} -match glob -result {{$p(:0:)} {$p(:*:)} -- 1 {can't find package http 1} --\ + {TCLLIB */dummy/unixlike/test/path} -- {}} test safe-7.3 {check that safe subinterpreters work} { set g [interp slaves] if {$g ne {}} { @@ -384,29 +402,30 @@ test safe-7.4 {tests specific path and positive search} -setup { set token1 [safe::interpAddToAccessPath $i [info library]] # should add as p* (not p1 if master has a module path) set token2 [safe::interpAddToAccessPath $i [file join $TestsDir auto0 auto1]] + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] # this time, unlike test safe-7.2, SafeTestPackage1 should be found - list $token1 $token2 \ - [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg \ - [safe::interpConfigure $i]\ - [safe::interpDelete $i] + list $token1 $token2 -- \ + [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \ + $mappA -- [safe::interpDelete $i] # Note that the glob match elides directories (those from the module path) # other than the first and last in the access path. } -cleanup { -} -match glob -result "{\$p(:0:)} {\$p(:*:)} 0 1.2.3\ - {-accessPath {[list $tcl_library * $TestsDir/auto0/auto1]}\ - -statics 0 -nested 1 -deleteHook {}} {}" +} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\ + {TCLLIB * TESTSDIR/auto0/auto1} -- {}} test safe-7.4http {tests specific path and positive search, uses http1.0} -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] # should not add anything (p0) set token1 [safe::interpAddToAccessPath $i [info library]] # should add as p1 set token2 [safe::interpAddToAccessPath $i [file join [info library] http1.0]] + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] # this time, unlike test safe-7.2, http should be found - list $token1 $token2 \ - [catch {interp eval $i {package require http 1}} msg] $msg \ - [safe::interpConfigure $i]\ - [safe::interpDelete $i] -} -match glob -result "{\$p(:0:)} {\$p(:*:)} 0 1.0 {-accessPath {[list $tcl_library *$tcl_library/http1.0]} -statics 0 -nested 1 -deleteHook {}} {}" + list $token1 $token2 -- \ + [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 source control on file name set i "a" @@ -632,9 +651,9 @@ test safe-9.8 {interpConfigure change the access path; tclIndex commands unaffec 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]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] @@ -653,6 +672,7 @@ test safe-9.8 {interpConfigure change the access path; tclIndex commands unaffec # Inspect. set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] @@ -660,23 +680,21 @@ test safe-9.8 {interpConfigure change the access path; tclIndex commands unaffec set code3 [catch {interp eval $i {report1}} msg3] set code4 [catch {interp eval $i {report2}} msg4] - list $path1 $path2 $path3 $path4 $code3 $msg3 $code4 $msg4 $confA $confB + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB } -cleanup { safe::interpDelete $i -} -match glob -result "{\$p(:1:)} {\$p(:2:)} {\$p(:2:)} {\$p(:1:)} 0 ok1 0 ok2\ - {-accessPath {[list $tcl_library $TestsDir/auto0/auto1 $TestsDir/auto0/auto2]*}\ - -statics 1 -nested 0 -deleteHook {}}\ - {-accessPath {[list $tcl_library $TestsDir/auto0/auto2 $TestsDir/auto0/auto1]*}\ - -statics 1 -nested 0 -deleteHook {}}" +} -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 \ [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2]]] - # Inspect. set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] @@ -693,6 +711,7 @@ test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffec # Inspect. set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] @@ -700,14 +719,13 @@ test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffec set code3 [catch {interp eval $i {report1}} msg3] set code4 [catch {interp eval $i {report2}} msg4] - list $path1 $path2 $path3 $path4 $code3 $msg3 $code4 $msg4 $confA $confB + list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB } -cleanup { safe::interpDelete $i -} -match glob -result "{\$p(:1:)} {\$p(:2:)} {\$p(:2:)} {\$p(:1:)} 0 ok1 0 ok2\ - {-accessPath {[list $tcl_library $TestsDir/auto0/auto1 $TestsDir/auto0/auto2]*}\ - -statics 1 -nested 0 -deleteHook {}}\ - {-accessPath {[list $tcl_library $TestsDir/auto0/auto2 $TestsDir/auto0/auto1]*}\ - -statics 1 -nested 0 -deleteHook {}}" +} -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.10 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement} -setup { } -body { @@ -719,6 +737,7 @@ test safe-9.10 {interpConfigure change the access path; pkgIndex.tcl packages un # Inspect. set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] @@ -736,6 +755,7 @@ test safe-9.10 {interpConfigure change the access path; pkgIndex.tcl packages un # Inspect. set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] @@ -745,17 +765,14 @@ test safe-9.10 {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 $confA $confB \ - $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(:2:)} {\$p(:3:)} {\$p(:3:)} {\$p(:2:)} 0 1.2.3 0 2.3.4\ - {-accessPath {[list $tcl_library $TestsDir/auto0 $TestsDir/auto0/auto1 $TestsDir/auto0/auto2]*}\ - -statics 1 -nested 0 -deleteHook {}}\ - {-accessPath {[list $tcl_library $TestsDir/auto0 $TestsDir/auto0/auto2 $TestsDir/auto0/auto1]*}\ - -statics 1 -nested 0 -deleteHook {}}\ - 0 OK1 0 OK2" +} -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\ + {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 { @@ -765,6 +782,7 @@ test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages un # Inspect. set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] @@ -778,6 +796,7 @@ test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages un # Inspect. set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] @@ -787,25 +806,23 @@ 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 $confA $confB \ + 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:)} 0 1.2.3 0 2.3.4\ - {-accessPath {[list $tcl_library $TestsDir/auto0/auto1 $TestsDir/auto0/auto2]*}\ - -statics 1 -nested 0 -deleteHook {}}\ - {-accessPath {[list $tcl_library $TestsDir/auto0/auto2 $TestsDir/auto0/auto1]*}\ - -statics 1 -nested 0 -deleteHook {}}\ - 0 OK1 0 OK2" - +} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\ + 0 1.2.3 0 2.3.4 --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ + {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\ + 0 OK1 0 OK2} test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed} -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]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] @@ -817,6 +834,7 @@ test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages fa # Inspect. set confB [safe::interpConfigure $i] + set mappB [mapList $PathMapp [dict get $confB -accessPath]] set code4 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]} path4] set code5 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]} path5] @@ -824,15 +842,12 @@ 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 $msg3 $code6 $msg6 $confA $confB + 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}\ - 1 {* not found in access path} 1 {*} 1 {*}\ - {-accessPath {[list $tcl_library $TestsDir/auto0/auto1 $TestsDir/auto0/auto2]*}\ - -statics 1 -nested 0 -deleteHook {}}\ - {-accessPath {[list $tcl_library]*} -statics 1 -nested 0 -deleteHook {}}" - +} -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\ + 1 {* not found in access path} -- 1 1 --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} -- {TCLLIB*}} test safe-9.20 {check module loading} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { @@ -844,6 +859,7 @@ test safe-9.20 {check module loading} -setup { # Inspect. set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] set modsA [interp eval $i {tcl::tm::path list}] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] @@ -857,22 +873,27 @@ test safe-9.20 {check module loading} -setup { set out1 [interp eval $i {mod1::test1::try1}] set out2 [interp eval $i {mod2::test2::try2}] - list $path0 $path1 $path2 -- $modsA -- \ - $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $confA -- $out0 $out1 $out2 + list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ + $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2 } -cleanup { tcl::tm::path remove [file join $TestsDir auto0 modules] foreach path [lreverse $oldTm] { tcl::tm::path add $path } safe::interpDelete $i -} -match glob -result "{\$p(:1:)} {\$p(:2:)} {\$p(:3:)} -- {{\$p(:1:)}} --\ +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ 0 0.5 0 1.0 0 2.0 --\ - {-accessPath {[list $tcl_library $TestsDir/auto0/modules \ - $TestsDir/auto0/modules/mod1 \ - $TestsDir/auto0/modules/mod2]*}\ - -statics 1 -nested 0 -deleteHook {}} --\ - res0 res1 res2" - + {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ + TESTSDIR/auto0/modules/mod2} -- res0 res1 res2} +# - The command safe::InterpSetConfig adds the master's [tcl::tm::list] in +# tokenized form to the slave's access path, and then adds all the +# descendants, discovered recursively by using glob. +# - The order of the directories in the list returned by glob is system-dependent, +# and therefore this is true also for (a) the order of token assignment to +# descendants of the [tcl::tm::list] roots; and (b) the order of those same +# directories in the access path. Both those things must be sorted before +# comparing with expected results. The test is therefore not totally strict, +# but will notice missing or surplus directories. test safe-9.21 {interpConfigure change the access path; check module loading; stale data case 1} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { @@ -884,6 +905,7 @@ test safe-9.21 {interpConfigure change the access path; check module loading; st # Inspect. set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] set modsA [interp eval $i {tcl::tm::path list}] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] @@ -897,6 +919,7 @@ test safe-9.21 {interpConfigure change the access path; check module loading; st # Inspect. set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] set modsB [interp eval $i {tcl::tm::path list}] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] @@ -915,8 +938,8 @@ 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 $path0 $path1 $path2 -- $modsA -- $path3 $path4 $path5 -- $modsB -- \ - $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $confA -- $confB -- \ + 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] @@ -924,23 +947,15 @@ test safe-9.21 {interpConfigure change the access path; check module loading; st tcl::tm::path add $path } safe::interpDelete $i -} -match glob -result "{\$p(:1:)} {\$p(:2:)} {\$p(:3:)} -- {{\$p(:1:)}} --\ - {\$p(:3:)} {\$p(:4:)} {\$p(:5:)} -- {{\$p(:3:)}} --\ +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ - {-accessPath {[list $tcl_library \ - $TestsDir/auto0/modules \ - $TestsDir/auto0/modules/mod1 \ - $TestsDir/auto0/modules/mod2]}\ - -statics 1 -nested 0 -deleteHook {}} --\ - {-accessPath {[list $tcl_library \ - $TestsDir/auto0/auto1 \ - $TestsDir/auto0/auto2 \ - $TestsDir/auto0/modules \ - $TestsDir/auto0/modules/mod1 \ - $TestsDir/auto0/modules/mod2]}\ - -statics 1 -nested 0 -deleteHook {}} --\ - res0 res1 res2" - + {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ + TESTSDIR/auto0/modules/mod2} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ + TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. test safe-9.22 {interpConfigure change the access path; check module loading; stale data case 0} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { @@ -952,6 +967,7 @@ test safe-9.22 {interpConfigure change the access path; check module loading; st # Inspect. set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] set modsA [interp eval $i {tcl::tm::path list}] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] @@ -965,6 +981,7 @@ test safe-9.22 {interpConfigure change the access path; check module loading; st # Inspect. set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] set modsB [interp eval $i {tcl::tm::path list}] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] @@ -978,8 +995,8 @@ 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 $path0 $path1 $path2 -- $modsA -- $path3 $path4 $path5 -- $modsB -- \ - $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $confA -- $confB -- \ + 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] @@ -987,23 +1004,15 @@ test safe-9.22 {interpConfigure change the access path; check module loading; st tcl::tm::path add $path } safe::interpDelete $i -} -match glob -result "{\$p(:1:)} {\$p(:2:)} {\$p(:3:)} -- {{\$p(:1:)}} --\ - {\$p(:3:)} {\$p(:4:)} {\$p(:5:)} -- {{\$p(:3:)}} --\ +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ - {-accessPath {[list $tcl_library \ - $TestsDir/auto0/modules \ - $TestsDir/auto0/modules/mod1 \ - $TestsDir/auto0/modules/mod2]}\ - -statics 1 -nested 0 -deleteHook {}} --\ - {-accessPath {[list $tcl_library \ - $TestsDir/auto0/auto1 \ - $TestsDir/auto0/auto2 \ - $TestsDir/auto0/modules \ - $TestsDir/auto0/modules/mod1 \ - $TestsDir/auto0/modules/mod2]}\ - -statics 1 -nested 0 -deleteHook {}} --\ - res0 res1 res2" - + {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ + TESTSDIR/auto0/modules/mod2} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ + TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. test safe-9.23 {interpConfigure change the access path; check module loading; stale data case 3} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { @@ -1015,6 +1024,7 @@ test safe-9.23 {interpConfigure change the access path; check module loading; st # Inspect. set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] set modsA [interp eval $i {tcl::tm::path list}] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] @@ -1033,6 +1043,7 @@ test safe-9.23 {interpConfigure change the access path; check module loading; st # Inspect. set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] set modsB [interp eval $i {tcl::tm::path list}] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] @@ -1051,8 +1062,8 @@ 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 $path0 $path1 $path2 -- $modsA -- $path3 $path4 $path5 -- $modsB -- \ - $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $confA -- $confB -- \ + 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 { @@ -1061,23 +1072,15 @@ test safe-9.23 {interpConfigure change the access path; check module loading; st tcl::tm::path add $path } safe::interpDelete $i -} -match glob -result "{\$p(:1:)} {\$p(:2:)} {\$p(:3:)} -- {{\$p(:1:)}} --\ - {\$p(:3:)} {\$p(:4:)} {\$p(:5:)} -- {{\$p(:3:)}} --\ +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ - {-accessPath {[list $tcl_library \ - $TestsDir/auto0/modules \ - $TestsDir/auto0/modules/mod1 \ - $TestsDir/auto0/modules/mod2]}\ - -statics 1 -nested 0 -deleteHook {}} --\ - {-accessPath {[list $tcl_library \ - $TestsDir/auto0/auto1 \ - $TestsDir/auto0/auto2 \ - $TestsDir/auto0/modules \ - $TestsDir/auto0/modules/mod1 \ - $TestsDir/auto0/modules/mod2]}\ - -statics 1 -nested 0 -deleteHook {}} --\ - res0 res1 res2" - + {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ + TESTSDIR/auto0/modules/mod2} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ + TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. test safe-9.24 {interpConfigure change the access path; check module loading; stale data case 2 (worst case)} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { @@ -1089,6 +1092,7 @@ test safe-9.24 {interpConfigure change the access path; check module loading; st # Inspect. set confA [safe::interpConfigure $i] + set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]] set modsA [interp eval $i {tcl::tm::path list}] set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] @@ -1107,6 +1111,7 @@ test safe-9.24 {interpConfigure change the access path; check module loading; st # Inspect. set confB [safe::interpConfigure $i] + set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]] set modsB [interp eval $i {tcl::tm::path list}] set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]] set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]] @@ -1120,8 +1125,8 @@ 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 $path0 $path1 $path2 -- $modsA -- $path3 $path4 $path5 -- $modsB -- \ - $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $confA -- $confB -- \ + 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] @@ -1129,23 +1134,15 @@ test safe-9.24 {interpConfigure change the access path; check module loading; st tcl::tm::path add $path } safe::interpDelete $i -} -match glob -result "{\$p(:1:)} {\$p(:2:)} {\$p(:3:)} -- {{\$p(:1:)}} --\ - {\$p(:3:)} {\$p(:4:)} {\$p(:5:)} -- {{\$p(:3:)}} --\ +} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\ + {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\ 0 0.5 0 1.0 0 2.0 --\ - {-accessPath {[list $tcl_library \ - $TestsDir/auto0/modules \ - $TestsDir/auto0/modules/mod1 \ - $TestsDir/auto0/modules/mod2]}\ - -statics 1 -nested 0 -deleteHook {}} --\ - {-accessPath {[list $tcl_library \ - $TestsDir/auto0/auto1 \ - $TestsDir/auto0/auto2 \ - $TestsDir/auto0/modules \ - $TestsDir/auto0/modules/mod1 \ - $TestsDir/auto0/modules/mod2]}\ - -statics 1 -nested 0 -deleteHook {}} --\ - res0 res1 res2" - + {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\ + TESTSDIR/auto0/modules/mod2} --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\ + TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\ + res0 res1 res2} +# See comments on lsort after test safe-9.20. catch {teststaticpkg Safepkg1 0 0} test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup { @@ -1440,15 +1437,12 @@ test safe-13.7 {mimic the glob call by tclPkgUnknown in a safe interpreter [Bug } -body { set safeTD [::safe::interpAddToAccessPath $i $testdir] ::safe::interpAddToAccessPath $i $testdir2 - string map [list $safeTD EXPECTED] [$i eval [list \ + mapList [list $safeTD EXPECTED] [$i eval [list \ glob -directory $safeTD -join * pkgIndex.tcl]] } -cleanup { safe::interpDelete $i removeDirectory $testdir -} -result {{EXPECTED/deletemetoo/pkgIndex.tcl}} -# Note the extra {} around the result above; that's *expected* because the -# tokenized paths require delimitation in the list returned by glob; the -# braces remain after the token is replaced by EXPECTED. +} -result {EXPECTED/deletemetoo/pkgIndex.tcl} test safe-13.7a {mimic the glob call by tclPkgUnknown in a safe interpreter with multiple subdirectories} -setup { set i [safe::interpCreate] buildEnvironment2 pkgIndex.tcl @@ -1456,14 +1450,12 @@ test safe-13.7a {mimic the glob call by tclPkgUnknown in a safe interpreter with set safeTD [::safe::interpAddToAccessPath $i $testdir] ::safe::interpAddToAccessPath $i $testdir2 ::safe::interpAddToAccessPath $i $testdir3 - lsort [string map [list $safeTD EXPECTED] [$i eval [list \ - glob -directory $safeTD -join * pkgIndex.tcl]]] + mapAndSortList [list $safeTD EXPECTED] [$i eval [list \ + glob -directory $safeTD -join * pkgIndex.tcl]] } -cleanup { safe::interpDelete $i removeDirectory $testdir } -result {EXPECTED/deleteme/pkgIndex.tcl EXPECTED/deletemetoo/pkgIndex.tcl} -# Cf safe-13.7 - this time there's no extra {} around the result; the list -# operation lsort removed it. 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 @@ -1601,7 +1593,10 @@ test safe-16.4 {Bug 3529949: defang ~user in globs} -setup { } -result {} set ::auto_path $saveAutoPath -unset saveAutoPath TestsDir +unset saveAutoPath TestsDir PathMapp +rename mapList {} +rename mapAndSortList {} + # cleanup ::tcltest::cleanupTests return -- cgit v0.12 From 651f71edfd77b66fd1e585154b7f4390e6df2b6f Mon Sep 17 00:00:00 2001 From: kjnash Date: Sat, 18 Jul 2020 04:12:08 +0000 Subject: Tidying tests/safe.test --- tests/safe.test | 128 +++++++++++++++++++++++++++++++------------------------- 1 file changed, 70 insertions(+), 58 deletions(-) diff --git a/tests/safe.test b/tests/safe.test index dbcd2cc..2683b9c 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -21,9 +21,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] @@ -194,6 +193,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... @@ -213,7 +213,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] @@ -228,7 +227,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] @@ -238,7 +236,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 @@ -247,7 +244,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] \ @@ -258,7 +254,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 @@ -267,7 +262,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 { @@ -282,7 +276,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] @@ -295,7 +288,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 { @@ -306,7 +298,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] @@ -393,7 +384,8 @@ 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} -setup { } -body { @@ -428,24 +420,28 @@ test safe-7.4http {tests specific path and positive search, uses http1.0} -body } -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.0 -- {TCLLIB *TCLLIB/http1.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} @@ -456,10 +452,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} @@ -470,10 +468,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} @@ -488,10 +488,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} @@ -504,10 +506,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} @@ -522,14 +526,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 { @@ -539,8 +545,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 { @@ -553,10 +561,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 { @@ -569,8 +578,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 {} @@ -591,7 +604,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 @@ -620,16 +635,18 @@ test safe-9.6 {interpConfigure widget like behaviour} -body { safe::interpConfigure $i]\ [safe::interpConfigure $i -deleteHook toto -nosta -nested 0 safe::interpConfigure $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}} - +} -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}} 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] @@ -644,8 +661,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 \ @@ -669,7 +689,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]] @@ -686,7 +705,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 \ @@ -708,7 +726,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]] @@ -726,7 +743,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. @@ -734,7 +750,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]] @@ -752,7 +767,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]] @@ -773,13 +787,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]] @@ -793,7 +805,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]] @@ -806,8 +817,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:)} --\ @@ -842,7 +854,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} --\ @@ -916,7 +929,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]] @@ -938,9 +950,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] { @@ -978,7 +991,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]] @@ -995,9 +1007,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] { @@ -1040,7 +1053,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]] @@ -1062,10 +1074,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] { @@ -1108,7 +1120,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]] @@ -1125,9 +1136,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] { @@ -1593,8 +1605,8 @@ test safe-16.4 {Bug 3529949: defang ~user in globs} -setup { safe::interpDelete $i } -result {} -set ::auto_path $saveAutoPath -unset saveAutoPath TestsDir PathMapp +set ::auto_path $SaveAutoPath +unset SaveAutoPath TestsDir PathMapp rename mapList {} rename mapAndSortList {} -- cgit v0.12 From 2a52ff28dd5deb1dc6fde4f0fdbbb85aa6b4efe3 Mon Sep 17 00:00:00 2001 From: kjnash Date: Sat, 18 Jul 2020 12:53:53 +0000 Subject: Remove code block in ::safe::AliasGlob that no longer serves a useful purpose. --- library/safe.tcl | 7 ------- 1 file changed, 7 deletions(-) diff --git a/library/safe.tcl b/library/safe.tcl index 74aee87..e645085 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -792,13 +792,6 @@ proc ::safe::AliasGlob {slave args} { set virtualdir [lindex $args [incr at]] incr at } - pkgIndex.tcl { - # Oops, this is globbing a subdirectory in regular package - # search. That is not wanted. Abort, handler does catch - # already (because glob was not defined before). See - # package.tcl, lines 484ff in tclPkgUnknown. - return -code error "unknown command glob" - } -* { Log $slave "Safe base rejecting glob option '$opt'" return -code error "Safe base rejecting glob option '$opt'" -- cgit v0.12 From a300508fee9c27bc2ea2bf95a19d7007dcd26424 Mon Sep 17 00:00:00 2001 From: kjnash Date: Sat, 18 Jul 2020 13:09:25 +0000 Subject: Remove unused code for *.tm from ::safe::AliasGlob. --- library/safe.tcl | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/library/safe.tcl b/library/safe.tcl index e645085..843255a 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -831,8 +831,7 @@ proc ::safe::AliasGlob {slave args} { } elseif {[string match ~* $thedir]} { set thedir ./$thedir } - if {$thedir eq "*" && - ($thefile eq "pkgIndex.tcl" || $thefile eq "*.tm")} { + if {($thedir eq "*") && ($thefile eq "pkgIndex.tcl")} { set mapped 0 foreach d [glob -directory [TranslatePath $slave $virtualdir] \ -types d -tails *] { -- cgit v0.12 From 690f2c283978a046e78664a1070c5c0bf5ddf67f Mon Sep 17 00:00:00 2001 From: kjnash Date: Sat, 18 Jul 2020 13:18:48 +0000 Subject: Bugfix argument combination -- and -directory in ::safe::AliasGlob. --- library/safe.tcl | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/library/safe.tcl b/library/safe.tcl index 843255a..410a5c1 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -815,7 +815,11 @@ proc ::safe::AliasGlob {slave args} { if {$got(-nocomplain)} return return -code error "permission denied" } - lappend cmd -directory $dir + if {$got(--)} { + set cmd [linsert $cmd end-1 -directory $dir] + } else { + lappend cmd -directory $dir + } } # Apply the -join semantics ourselves -- cgit v0.12 From 6310c709d39e30dcefc165aa242973e919d86134 Mon Sep 17 00:00:00 2001 From: kjnash Date: Sat, 18 Jul 2020 13:22:31 +0000 Subject: Update comments about safe interpreters in library/tm.tcl and library/package.tcl so they agree with code --- library/package.tcl | 10 +++++++--- library/tm.tcl | 11 ++++++----- 2 files changed, 13 insertions(+), 8 deletions(-) diff --git a/library/package.tcl b/library/package.tcl index 44e3b28..d6280ae 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -479,9 +479,12 @@ proc tclPkgUnknown {name args} { } set tclSeenPath($dir) 1 - # we can't use glob in safe interps, so enclose the following in a - # catch statement, where we get the pkgIndex files out of the - # subdirectories + # Get the pkgIndex.tcl files in subdirectories of auto_path directories. + # - Safe Base interpreters have a restricted "glob" command that + # works in this case. + # - The "catch" was essential when there was no safe glob and every + # call in a safe interp failed; it is retained only for corner + # cases in which the eventual call to glob returns an error. catch { foreach file [glob -directory $dir -join -nocomplain \ * pkgIndex.tcl] { @@ -585,6 +588,7 @@ proc tcl::MacOSXPkgUnknown {original name args} { set tclSeenPath($dir) 1 # get the pkgIndex files out of the subdirectories + # Safe interpreters do not use tcl::MacOSXPkgUnknown - see init.tcl. foreach file [glob -directory $dir -join -nocomplain \ * Resources Scripts pkgIndex.tcl] { set dir [file dirname $file] diff --git a/library/tm.tcl b/library/tm.tcl index 0ed3f1a..c60084c 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -212,11 +212,12 @@ proc ::tcl::tm::UnknownHandler {original name args} { } set strip [llength [file split $path]] - # We can't use glob in safe interps, so enclose the following in a - # catch statement, where we get the module files out of the - # subdirectories. In other words, Tcl Modules are not-functional - # in such an interpreter. This is the same as for the command - # "tclPkgUnknown", i.e. the search for regular packages. + # Get the module files out of the subdirectories. + # - Safe Base interpreters have a restricted "glob" command that + # works in this case. + # - The "catch" was essential when there was no safe glob and every + # call in a safe interp failed; it is retained only for corner + # cases in which the eventual call to glob returns an error. catch { # We always look for _all_ possible modules in the current -- cgit v0.12 From 201d01f9da1f2fb006cc4c0fc265e552cf9c2703 Mon Sep 17 00:00:00 2001 From: kjnash Date: Sat, 18 Jul 2020 17:51:27 +0000 Subject: Add explanatory comments to safe::AliasGlob --- library/safe.tcl | 33 +++++++++++++++++++++++++++++++-- tests/safe.test | 49 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 80 insertions(+), 2 deletions(-) diff --git a/library/safe.tcl b/library/safe.tcl index 410a5c1..da6523c 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -822,19 +822,27 @@ proc ::safe::AliasGlob {slave args} { } } - # Apply the -join semantics ourselves + # Apply the -join semantics ourselves. if {$got(-join)} { set args [lreplace $args $at end [join [lrange $args $at end] "/"]] } - # Process remaining pattern arguments + # Process the pattern arguments. If we've done a join there is only one + # pattern argument. + set firstPattern [llength $cmd] foreach opt [lrange $args $at end] { if {![regexp $dirPartRE $opt -> thedir thefile]} { set thedir . + # The *.tm search comes here. } elseif {[string match ~* $thedir]} { set thedir ./$thedir } + # "Special" treatment for (joined) argument {*/pkgIndex.tcl}. + # Do the expansion of "*" here, and filter out any directories that are + # not in the access path. The outcome is to lappend to cmd a path of + # the form $virtualdir/subdir/pkgIndex.tcl for each subdirectory subdir, + # after removing any subdir that are not in the access path. if {($thedir eq "*") && ($thefile eq "pkgIndex.tcl")} { set mapped 0 foreach d [glob -directory [TranslatePath $slave $virtualdir] \ @@ -847,7 +855,19 @@ proc ::safe::AliasGlob {slave args} { } } if {$mapped} continue + # Don't [continue] if */pkgIndex.tcl has no matches in the access + # path. The pattern will now receive the same treatment as a + # "non-special" pattern (and will fail because it includes a "*" in + # the directory name). } + # Any directory pattern that is not an exact (i.e. non-glob) match to a + # directory in the access path will be rejected here. + # - Rejections include any directory pattern that has glob matching + # patterns "*", "?", backslashes, braces or square brackets, (UNLESS + # it corresponds to a genuine directory name AND that directory is in + # the access path). + # - The only "special matching characters" that remain in patterns for + # processing by glob are in the filename tail. try { DirInAccessPath $slave [TranslatePath $slave \ [file join $virtualdir $thedir]] @@ -865,8 +885,17 @@ proc ::safe::AliasGlob {slave args} { return } try { + # >>>>>>>>>> HERE'S THE CALL TO SAFE INTERP GLOB <<<<<<<<<< + # - Pattern arguments added to cmd have NOT been translated from tokens. + # Only the virtualdir is translated (to dir). + # - In the pkgIndex.tcl case, there is no "*" in the pattern arguments, + # which are a list of names each with tail pkgIndex.tcl. The purpose + # of the call to glob is to remove the names for which the file does + # not exist. set entries [::interp invokehidden $slave glob {*}$cmd] } on error msg { + # This is the only place that a call with -nocomplain and no invalid + # "dash-options" can return an error. Log $slave $msg return -code error "script error" } diff --git a/tests/safe.test b/tests/safe.test index 2683b9c..9e90236 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -1572,6 +1572,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] @@ -1581,6 +1582,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] @@ -1595,6 +1597,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] @@ -1604,6 +1607,52 @@ 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} set ::auto_path $SaveAutoPath unset SaveAutoPath TestsDir PathMapp -- cgit v0.12 From d12eb85c8fe92ca27b4f03950a447068c2418cb8 Mon Sep 17 00:00:00 2001 From: kjnash Date: Sat, 18 Jul 2020 18:06:30 +0000 Subject: Simplify case analysis in safe::AliasGlob --- library/safe.tcl | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/library/safe.tcl b/library/safe.tcl index da6523c..f0a14a3 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -820,6 +820,13 @@ proc ::safe::AliasGlob {slave args} { } else { lappend cmd -directory $dir } + } else { + # The code after this "if ... else" block would conspire to return with + # no results in this case, if it were allowed to proceed. Instead, + # return now and reduce the number of cases to be considered later. + Log $slave {option -directory must be supplied} + if {$got(-nocomplain)} return + return -code error "permission denied" } # Apply the -join semantics ourselves. -- cgit v0.12 From a541a7be4cbbd4b2e5cca7ff65b98010dc224929 Mon Sep 17 00:00:00 2001 From: kjnash Date: Sat, 18 Jul 2020 18:51:53 +0000 Subject: Remove an old fix for ~ expansion in safe::AliasGlob that is now fixed by other means --- library/safe.tcl | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/library/safe.tcl b/library/safe.tcl index f0a14a3..4540be3 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -842,8 +842,6 @@ proc ::safe::AliasGlob {slave args} { if {![regexp $dirPartRE $opt -> thedir thefile]} { set thedir . # The *.tm search comes here. - } elseif {[string match ~* $thedir]} { - set thedir ./$thedir } # "Special" treatment for (joined) argument {*/pkgIndex.tcl}. # Do the expansion of "*" here, and filter out any directories that are @@ -875,6 +873,12 @@ proc ::safe::AliasGlob {slave args} { # the access path). # - The only "special matching characters" that remain in patterns for # processing by glob are in the filename tail. + # - [file join $anything ~${foo}] is ~${foo}, which is not an exact + # match to any directory in the access path. Hence directory patterns + # that begin with "~" are rejected here. Tests safe-16.[5-8] check + # that "file join" remains as required and does not expand ~${foo}. + # - Bug [3529949] relates to unwanted expansion of ~${foo} and this is + # how the present code avoids the bug. All tests safe-16.* relate. try { DirInAccessPath $slave [TranslatePath $slave \ [file join $virtualdir $thedir]] -- cgit v0.12 From e6a9f22409462ec90bb2009619173c4228809317 Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 20 Jul 2020 22:32:28 +0000 Subject: File tests/safe.test - rearrange tests - move tests of command/package loading that use Tcl files to new file tests/safe-stock86.test; renumber tests 9.8+ and add test 9.8 to replace old 5.1; move tests 7.0* to 5.*. --- tests/safe-stock86.test | 116 ++++++++++++++++++++++++++++++++ tests/safe.test | 172 ++++++++++++++++++++++-------------------------- 2 files changed, 193 insertions(+), 95 deletions(-) create mode 100644 tests/safe-stock86.test diff --git a/tests/safe-stock86.test b/tests/safe-stock86.test new file mode 100644 index 0000000..2fbe108 --- /dev/null +++ b/tests/safe-stock86.test @@ -0,0 +1,116 @@ +# safe-stock86.test -- +# +# This file contains tests for safe Tcl that were previously in the file +# safe.test, and use files and packages of stock Tcl 8.6 to perform the tests. +# These files may be changed or disappear in future revisions of Tcl, for +# example package http 1.0 will be removed from Tcl 8.7. +# +# The tests are replaced in safe.tcl with tests that use files provided in the +# tests directory. Test numbering is for comparison with similar tests in +# safe.test. +# +# Sourcing this file into tcl runs the tests and generates output for errors. +# No output means no errors were found. +# +# Copyright (c) 1995-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. + +package require Tcl 8.5- + +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest 2 + namespace import -force ::tcltest::* +} + +foreach i [interp slaves] { + interp delete $i +} + +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] + +proc mapList {map listIn} { + set listOut {} + foreach element $listIn { + lappend listOut [string map $map $element] + } + return $listOut +} + +# Force actual loading of the safe package because we use un-exported (and +# thus un-autoindexed) APIs in this test result arguments: +catch {safe::interpConfigure} + +# testing that nested and statics do what is advertised (we use a static +# package - Tcltest - but it might be absent if we're in standard tclsh) + +testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}] + +# high level general test +test safe-stock86-7.1 {tests that everything works at high level, uses http 2} -body { + set i [safe::interpCreate] + # no error shall occur: + # (because the default access_path shall include 1st level sub dirs so + # package require in a slave works like in the master) + set v [interp eval $i {package require http 2}] + # no error shall occur: + interp eval $i {http::config} + safe::interpDelete $i + set v +} -match glob -result 2.* +test safe-stock86-7.2 {tests specific path and interpFind/AddToAccessPath, uses http1.0} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p1 + set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + # an error shall occur (http is not anymore in the secure 0-level + # provided deep path) + list $token1 $token2 -- \ + [catch {interp eval $i {package require http 1}} msg] $msg -- \ + $mappA -- [safe::interpDelete $i] +} -match glob -result {{$p(:0:)} {$p(:*:)} -- 1 {can't find package http 1} --\ + {TCLLIB */dummy/unixlike/test/path} -- {}} +test safe-stock86-7.4 {tests specific path and positive search, uses http1.0} -body { + set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] + # should not add anything (p0) + set token1 [safe::interpAddToAccessPath $i [info library]] + # should add as p1 + set token2 [safe::interpAddToAccessPath $i [file join [info library] http1.0]] + set confA [safe::interpConfigure $i] + set mappA [mapList $PathMapp [dict get $confA -accessPath]] + # this time, unlike test safe-stock86-7.2, http should be found + list $token1 $token2 -- \ + [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} -- {}} + +# The following test checks whether the definition of tcl_endOfWord can be +# obtained from auto_loading. It was previously test "safe-5.1". +test safe-stock86-9.8 {test auto-loading in safe interpreters, was test 5.1} -setup { + catch {safe::interpDelete a} + safe::interpCreate a +} -body { + interp eval a {tcl_endOfWord "" 0} +} -cleanup { + safe::interpDelete a +} -result -1 + +set ::auto_path $SaveAutoPath +unset SaveAutoPath TestsDir PathMapp +rename mapList {} + +# cleanup +::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# End: diff --git a/tests/safe.test b/tests/safe.test index 9e90236..3511625 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -4,6 +4,17 @@ # using safe interpreters. Sourcing this file into tcl runs the tests and # generates output for errors. No output means no errors were found. # +# The package http 1.0 is convenient for testing package loading, but will soon +# be removed. +# - Tests that use http are replaced here with tests that use example packages +# provided in subdirectory auto0 of the tests directory, which are independent +# of any changes made to the packages provided with Tcl itself. +# - These are tests 7.1 7.2 7.4 9.11 9.13 +# - Tests 5.* test the example packages themselves before they +# are used to test Safe Base interpreters. +# - Alternative tests using stock packages of Tcl 8.6 are in file +# safe-stock86.test. +# # Copyright (c) 1995-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # @@ -155,51 +166,11 @@ test safe-4.6 {safe::interpDelete, indirectly} -setup { a eval exit } -result "" -# The following test checks whether the definition of tcl_endOfWord can be -# obtained from auto_loading. - -test safe-5.1 {test auto-loading in safe interpreters} -setup { - catch {safe::interpDelete a} - safe::interpCreate a -} -body { - interp eval a {tcl_endOfWord "" 0} -} -cleanup { - safe::interpDelete a -} -result -1 - -# test safe interps 'information leak' -proc SafeEval {script} { - # Helper procedure that ensures the safe interp is cleaned up even if - # there is a failure in the script. - set SafeInterp [interp create -safe] - catch {$SafeInterp eval $script} msg opts - interp delete $SafeInterp - return -options $opts $msg -} +# The old test "safe-5.1" has been moved to "safe-stock86-9.8". +# A replacement test using example files is "safe-9.8". +# Tests 5.* test the example files before using them to test safe interpreters. -test safe-6.1 {test safe interpreters knowledge of the world} { - lsort [SafeEval {info globals}] -} {tcl_interactive tcl_patchLevel tcl_platform tcl_version} -test safe-6.2 {test safe interpreters knowledge of the world} { - SafeEval {info script} -} {} -test safe-6.3 {test safe interpreters knowledge of the world} { - set r [SafeEval {array names tcl_platform}] - # If running a windows-debug shell, remove the "debug" element from r. - if {[testConstraint win]} { - set r [lsearch -all -inline -not -exact $r "debug"] - } - set r [lsearch -all -inline -not -exact $r "threaded"] - 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... - -# Tests 7.0* test the example files before using them to test safe interpreters. - -test safe-7.0a {example tclIndex commands, test in master interpreter} -setup { +test safe-5.1 {example tclIndex commands, test in master interpreter} -setup { set tmpAutoPath $::auto_path lappend ::auto_path [file join $TestsDir auto0 auto1] [file join $TestsDir auto0 auto2] } -body { @@ -213,7 +184,7 @@ 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 { +test safe-5.2 {example tclIndex commands, negative test in master interpreter} -setup { set tmpAutoPath $::auto_path lappend ::auto_path [file join $TestsDir auto0] } -body { @@ -227,7 +198,7 @@ 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 { +test safe-5.3 {example pkgIndex.tcl packages, test in master interpreter, child directories} -setup { set tmpAutoPath $::auto_path lappend ::auto_path [file join $TestsDir auto0] } -body { @@ -244,7 +215,7 @@ 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 { +test safe-5.4 {example pkgIndex.tcl packages, test in master interpreter, main directories} -setup { set tmpAutoPath $::auto_path lappend ::auto_path [file join $TestsDir auto0 auto1] \ [file join $TestsDir auto0 auto2] @@ -262,7 +233,7 @@ 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 { +test safe-5.5 {example modules packages, test in master interpreter, replace path} -setup { set oldTm [tcl::tm::path list] foreach path $oldTm { tcl::tm::path remove $path @@ -288,7 +259,7 @@ 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 { +test safe-5.6 {example modules packages, test in master interpreter, append to path} -setup { tcl::tm::path add [file join $TestsDir auto0 modules] } -body { # Try to load the modules and run a command from each one. @@ -308,6 +279,37 @@ test safe-7.0f {example modules packages, test in master interpreter, append to catch {namespace delete ::mod1} } -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2} + +# test safe interps 'information leak' +proc SafeEval {script} { + # Helper procedure that ensures the safe interp is cleaned up even if + # there is a failure in the script. + set SafeInterp [interp create -safe] + catch {$SafeInterp eval $script} msg opts + interp delete $SafeInterp + return -options $opts $msg +} + +test safe-6.1 {test safe interpreters knowledge of the world} { + lsort [SafeEval {info globals}] +} {tcl_interactive tcl_patchLevel tcl_platform tcl_version} +test safe-6.2 {test safe interpreters knowledge of the world} { + SafeEval {info script} +} {} +test safe-6.3 {test safe interpreters knowledge of the world} { + set r [SafeEval {array names tcl_platform}] + # If running a windows-debug shell, remove the "debug" element from r. + if {[testConstraint win]} { + set r [lsearch -all -inline -not -exact $r "debug"] + } + set r [lsearch -all -inline -not -exact $r "threaded"] + 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... + # high level general test # Use example packages not http1.0 test safe-7.1 {tests that everything works at high level} -setup { @@ -326,18 +328,6 @@ test safe-7.1 {tests that everything works at high level} -setup { } -cleanup { safe::interpDelete $i } -match glob -result 1.2.3 -# high level general test -test safe-7.1http {tests that everything works at high level, uses http 2} -body { - set i [safe::interpCreate] - # no error shall occur: - # (because the default access_path shall include 1st level sub dirs so - # package require in a slave works like in the master) - set v [interp eval $i {package require http 2}] - # no error shall occur: - interp eval $i {http::config} - safe::interpDelete $i - set v -} -match glob -result 2.* test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -setup { } -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] @@ -358,21 +348,6 @@ test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -setup { } -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\ 1 {can't find package SafeTestPackage1} --\ {TCLLIB */dummy/unixlike/test/path TESTSDIR/auto0} -- {}} -test safe-7.2http {tests specific path and interpFind/AddToAccessPath, uses http1.0} -body { - set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] - # should not add anything (p0) - set token1 [safe::interpAddToAccessPath $i [info library]] - # should add as p1 - set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] - set confA [safe::interpConfigure $i] - set mappA [mapList $PathMapp [dict get $confA -accessPath]] - # an error shall occur (http is not anymore in the secure 0-level - # provided deep path) - list $token1 $token2 -- \ - [catch {interp eval $i {package require http 1}} msg] $msg -- \ - $mappA -- [safe::interpDelete $i] -} -match glob -result {{$p(:0:)} {$p(:*:)} -- 1 {can't find package http 1} --\ - {TCLLIB */dummy/unixlike/test/path} -- {}} test safe-7.3 {check that safe subinterpreters work} { set g [interp slaves] if {$g ne {}} { @@ -405,19 +380,6 @@ test safe-7.4 {tests specific path and positive search} -setup { } -cleanup { } -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\ {TCLLIB * TESTSDIR/auto0/auto1} -- {}} -test safe-7.4http {tests specific path and positive search, uses http1.0} -body { - set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] - # should not add anything (p0) - set token1 [safe::interpAddToAccessPath $i [info library]] - # should add as p1 - set token2 [safe::interpAddToAccessPath $i [file join [info library] http1.0]] - set confA [safe::interpConfigure $i] - set mappA [mapList $PathMapp [dict get $confA -accessPath]] - # this time, unlike test safe-7.2, http should be found - list $token1 $token2 -- \ - [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 source control on file name test safe-8.1 {safe source control on file} -setup { @@ -666,7 +628,27 @@ test safe-9.7 {interpConfigure widget like behaviour (demystified)} -body { {-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 { +test safe-9.8 {test autoloading commands indexed in tclIndex files} -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]] + set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]] + set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]] + + # Load and run the commands. + set code1 [catch {interp eval $i {report1}} msg1] + set code2 [catch {interp eval $i {report2}} msg2] + + list $path1 $path2 -- $code1 $msg1 $code2 $msg2 -- $mappA +} -cleanup { + safe::interpDelete $i +} -match glob -result {{$p(:1:)} {$p(:2:)} -- 0 ok1 0 ok2 --\ + {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*}} +test safe-9.9 {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 \ [file join $TestsDir auto0 auto1] \ @@ -705,7 +687,7 @@ 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 { +test safe-9.10 {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 \ [file join $TestsDir auto0 auto1] \ @@ -743,7 +725,7 @@ 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 { +test safe-9.11 {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. set i [safe::interpCreate -accessPath [list $tcl_library \ @@ -787,7 +769,7 @@ 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 { +test safe-9.12 {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] \ @@ -827,7 +809,7 @@ test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages un {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\ 0 OK1 0 OK2} -test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed} -setup { +test safe-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed} -setup { } -body { set i [safe::interpCreate -accessPath [list $tcl_library \ [file join $TestsDir auto0 auto1] \ @@ -1455,7 +1437,7 @@ test safe-13.7 {mimic the glob call by tclPkgUnknown in a safe interpreter [Bug safe::interpDelete $i removeDirectory $testdir } -result {EXPECTED/deletemetoo/pkgIndex.tcl} -test safe-13.7a {mimic the glob call by tclPkgUnknown in a safe interpreter with multiple subdirectories} -setup { +test safe-13.7.1 {mimic the glob call by tclPkgUnknown in a safe interpreter with multiple subdirectories} -setup { set i [safe::interpCreate] buildEnvironment2 pkgIndex.tcl } -body { -- cgit v0.12 From 204434e4d41bb9e07b48d28331a6a63206dc36dd Mon Sep 17 00:00:00 2001 From: kjnash Date: Tue, 21 Jul 2020 03:59:35 +0000 Subject: Use suitable -errorcode in safe::AliasSource if file does not exist or is unreadable. Fixes bug f3ba57600d. --- library/safe.tcl | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/library/safe.tcl b/library/safe.tcl index 4540be3..9b8a04f 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -968,12 +968,15 @@ proc ::safe::AliasSource {slave args} { return -code error "permission denied" } - # do the checks on the filename : + # Check that the filename exists and is readable. If it is not, deliver + # this -errorcode so that caller in tclPkgUnknown does not write a message + # to tclLog. Has no effect on other callers of ::source, which are in + # "package ifneeded" scripts. if {[catch { CheckFileName $slave $realfile } msg]} { Log $slave "$realfile:$msg" - return -code error $msg + return -code error -errorcode {POSIX EACCES} $msg } # Passed all the tests, lets source it. Note that we do this all manually -- cgit v0.12 From 14cfbc651c24aa44c83023e8bba2781d322b230f Mon Sep 17 00:00:00 2001 From: kjnash Date: Tue, 21 Jul 2020 17:25:03 +0000 Subject: Adapt Safe Base for interpreter names with namespace separators. Add a test and revise safe(n). Fixes bug [693851]. --- doc/safe.n | 10 +++++- library/safe.tcl | 92 +++++++++++++++++++++++++++++++++++++++++++++----------- tests/safe.test | 17 +++++++++++ 3 files changed, 100 insertions(+), 19 deletions(-) diff --git a/doc/safe.n b/doc/safe.n index b39f2c2..7ddb182 100644 --- a/doc/safe.n +++ b/doc/safe.n @@ -72,11 +72,19 @@ See the \fBOPTIONS\fR section below for a description of the optional arguments. If the \fIslave\fR argument is omitted, a name will be generated. \fB::safe::interpCreate\fR always returns the interpreter name. +.sp +The interpreter name \fIslave\fR may include namespace separators, +but may not have leading or trailing namespace separators, or excess +colon characters in namespace separators. The interpreter name is +qualified relative to the global namespace ::, not the namespace in which +the \fB::safe::interpCreate\fR command is evaluated. .TP \fB::safe::interpInit\fR \fIslave\fR ?\fIoptions...\fR? This command is similar to \fBinterpCreate\fR except it that does not create the safe interpreter. \fIslave\fR must have been created by some -other means, like \fBinterp create\fR \fB\-safe\fR. +other means, like \fBinterp create\fR \fB\-safe\fR. The interpreter +name \fIslave\fR may include namespace separators, subject to the same +restrictions as for \fBinterpCreate\fR. .TP \fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR? If no \fIoptions\fR are given, returns the settings for all options for the diff --git a/library/safe.tcl b/library/safe.tcl index 9b8a04f..6b531be 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -79,6 +79,7 @@ proc ::safe::InterpNested {} { # Interface/entry point function and front end for "Create" proc ::safe::interpCreate {args} { set Args [::tcl::OptKeyParse ::safe::interpCreate $args] + RejectExcessColons $slave InterpCreate $slave $accessPath \ [InterpStatics] [InterpNested] $deleteHook } @@ -88,13 +89,14 @@ proc ::safe::interpInit {args} { if {![::interp exists $slave]} { return -code error "\"$slave\" is not an interpreter" } + RejectExcessColons $slave InterpInit $slave $accessPath \ [InterpStatics] [InterpNested] $deleteHook } # Check that the given slave is "one of us" proc ::safe::CheckInterp {slave} { - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state if {![info exists state] || ![::interp exists $slave]} { return -code error \ "\"$slave\" is not an interpreter managed by ::safe::" @@ -123,7 +125,7 @@ proc ::safe::interpConfigure {args} { # checks for the "-help" option. set Args [::tcl::OptKeyParse ::safe::interpIC $args] CheckInterp $slave - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state return [join [list \ [list -accessPath $state(access_path)] \ @@ -146,7 +148,7 @@ proc ::safe::interpConfigure {args} { return -code error [::tcl::OptFlagUsage $desc $arg] } CheckInterp $slave - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state set item [::tcl::OptCurDesc $desc] set name [::tcl::OptName $item] @@ -187,7 +189,7 @@ proc ::safe::interpConfigure {args} { # create did set Args [::tcl::OptKeyParse ::safe::interpIC $args] CheckInterp $slave - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state # Get the current (and not the default) values of whatever has # not been given: @@ -284,8 +286,10 @@ proc ::safe::InterpCreate { deletehook } { # Create the slave. + # If evaluated in ::safe, the interpreter command for foo is ::foo; + # but for foo::bar is safe::foo::bar. So evaluate in :: instead. if {$slave ne ""} { - ::interp create -safe $slave + namespace eval :: [list ::interp create -safe $slave] } else { # empty argument: generate slave name set slave [::interp create -safe] @@ -338,7 +342,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { Log $slave "Setting accessPath=($access_path) staticsok=$staticsok\ nestedok=$nestedok deletehook=($deletehook)" NOTICE - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state # clear old autopath if it existed # build new one @@ -440,7 +444,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { # Search for a real directory and returns its virtual Id (including the # "$") proc ::safe::interpFindInAccessPath {slave path} { - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state if {![dict exists $state(access_path,remap) $path]} { return -code error "$path not found in access path" @@ -456,7 +460,7 @@ proc ::safe::interpFindInAccessPath {slave path} { proc ::safe::interpAddToAccessPath {slave path} { # first check if the directory is already in there # (inlined interpFindInAccessPath). - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state if {[dict exists $state(access_path,remap) $path]} { return [dict get $state(access_path,remap) $path] @@ -555,7 +559,7 @@ proc ::safe::InterpInit { # Sync the paths used to search for Tcl modules. This can be done only # now, after tm.tcl was loaded. - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state if {[llength $state(tm_path_slave)] > 0} { ::interp eval $slave [list \ ::tcl::tm::add {*}[lreverse $state(tm_path_slave)]] @@ -592,7 +596,7 @@ proc ::safe::AddSubDirs {pathList} { proc ::safe::interpDelete {slave} { Log $slave "About to delete" NOTICE - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state # When an interpreter is deleted with [interp delete], any sub-interpreters # are deleted automatically, but this leaves behind their data in the Safe @@ -600,7 +604,7 @@ proc ::safe::interpDelete {slave} { # Safe Base sub-interpreter, so each one is deleted cleanly and not by # the automatic mechanism built into [interp delete]. foreach sub [interp slaves $slave] { - if {[info exists ::safe::S[list $slave $sub]]} { + if {[info exists ::safe::[VarName [list $slave $sub]]]} { ::safe::interpDelete [list $slave $sub] } } @@ -675,7 +679,7 @@ proc ::safe::setLogCmd {args} { # tcl_library to the first token of the virtual path. # proc ::safe::SyncAccessPath {slave} { - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state set slave_access_path $state(access_path,slave) ::interp eval $slave [list set auto_path $slave_access_path] @@ -702,7 +706,7 @@ proc ::safe::PathToken {n} { # translate virtual path into real path # proc ::safe::TranslatePath {slave path} { - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state # somehow strip the namespaces 'functionality' out (the danger is that # we would strip valid macintosh "../" queries... : @@ -1021,7 +1025,7 @@ proc ::safe::AliasLoad {slave file args} { # package name (can be empty if file is not). set package [lindex $args 0] - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state # Determine where to load. load use a relative interp path and {} # means self, so we can directly and safely use passed arg. @@ -1083,7 +1087,7 @@ proc ::safe::AliasLoad {slave file args} { # the security here relies on "file dirname" answering the proper # result... needs checking ? proc ::safe::FileInAccessPath {slave file} { - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state set access_path $state(access_path) if {[file isdirectory $file]} { @@ -1095,14 +1099,14 @@ proc ::safe::FileInAccessPath {slave file} { # potential pathname anomalies. set norm_parent [file normalize $parent] - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state if {$norm_parent ni $state(access_path,norm)} { return -code error "\"$file\": not in access_path" } } proc ::safe::DirInAccessPath {slave dir} { - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state set access_path $state(access_path) if {[file isfile $dir]} { @@ -1113,7 +1117,7 @@ proc ::safe::DirInAccessPath {slave dir} { # potential pathname anomalies. set norm_dir [file normalize $dir] - namespace upvar ::safe S$slave state + namespace upvar ::safe [VarName $slave] state if {$norm_dir ni $state(access_path,norm)} { return -code error "\"$dir\": not in access_path" } @@ -1154,6 +1158,58 @@ proc ::safe::AliasExeName {slave} { return "" } +# ------------------------------------------------------------------------------ +# Using Interpreter Names with Namespace Qualifiers +# ------------------------------------------------------------------------------ +# (1) We wish to preserve compatibility with existing code, in which Safe Base +# interpreter names have no namespace qualifiers. +# (2) safe::interpCreate and the rest of the Safe Base previously could not +# accept namespace qualifiers in an interpreter name. +# (3) The interp command will accept namespace qualifiers in an interpreter +# name, but accepts distinct interpreters that will have the same command +# name (e.g. foo, ::foo, and :::foo) (bug 66c2e8c974). +# (4) To satisfy these constraints, Safe Base interpreter names will be fully +# qualified namespace names with no excess colons and with the leading "::" +# omitted. +# (5) Trailing "::" implies a namespace tail {}, which interp reads as {{}}. +# Reject such names. +# (6) We could: +# (a) EITHER reject usable but non-compliant names (e.g. excess colons) in +# interpCreate, interpInit; +# (b) OR accept such names and then translate to a compliant name in every +# command. +# The problem with (b) is that the user will expect to use the name with the +# interp command and will find that it is not recognised. +# E.g "interpCreate ::foo" creates interpreter "foo", and the user's name +# "::foo" works with all the Safe Base commands, but "interp eval ::foo" +# fails. +# So we choose (a). +# (7) The command +# namespace upvar ::safe S$slave state +# becomes +# namespace upvar ::safe [VarName $slave] state +# ------------------------------------------------------------------------------ + +proc ::safe::RejectExcessColons {slave} { + set stripped [regsub -all -- {:::*} $slave ::] + if {[string range $stripped end-1 end] eq {::}} { + return -code error {interpreter name must not end in "::"} + } + if {$stripped ne $slave} { + set msg {interpreter name has excess colons in namespace separators} + return -code error $msg + } + if {[string range $stripped 0 1] eq {::}} { + return -code error {interpreter name must not begin "::"} + } + return +} + +proc ::safe::VarName {slave} { + # return S$slave + return S[string map {:: @N @ @A} $slave] +} + proc ::safe::Setup {} { #### # diff --git a/tests/safe.test b/tests/safe.test index 3511625..1415b09 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -362,6 +362,23 @@ test safe-7.3 {check that safe subinterpreters work} { list $g $h [interp eval $j {join {o k} ""}] [safe::interpDelete $i] \ [interp exists $j] [info vars ::safe::S*] } {{} {} ok {} 0 {}} +test safe-7.3.1 {check that safe subinterpreters work with namespace names} -setup { +} -body { + set g [interp slaves] + if {$g ne {}} { + append g { -- residue of an earlier test} + } + set h [info vars ::safe::S*] + if {$h ne {}} { + append h { -- residue of an earlier test} + } + set i [safe::interpCreate foo::bar] + set j [safe::interpCreate [list $i hello::world]] + list $g $h [interp eval $j {join {o k} ""}] \ + [foo::bar eval {hello::world eval {join {o k} ""}}] \ + [safe::interpDelete $i] \ + [interp exists $j] [info vars ::safe::S*] +} -match glob -result {{} {} ok ok {} 0 {}} test safe-7.4 {tests specific path and positive search} -setup { } -body { set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] -- cgit v0.12 From 720183a9af204a0db0d0211ea410609891ebd9d6 Mon Sep 17 00:00:00 2001 From: kjnash Date: Tue, 21 Jul 2020 17:34:03 +0000 Subject: In ::safe::interpFindInAccessPath, ::safe::interpAddToAccessPath, add a check that the interpreter belongs to the Safe Base. Add comments on why this is not done for ::safe::interpDelete. --- library/safe.tcl | 8 +++++++- tests/safe.test | 6 ++++++ 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/library/safe.tcl b/library/safe.tcl index 6b531be..3e8c2c6 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -444,6 +444,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { # Search for a real directory and returns its virtual Id (including the # "$") proc ::safe::interpFindInAccessPath {slave path} { + CheckInterp $slave namespace upvar ::safe [VarName $slave] state if {![dict exists $state(access_path,remap) $path]} { @@ -460,6 +461,7 @@ proc ::safe::interpFindInAccessPath {slave path} { proc ::safe::interpAddToAccessPath {slave path} { # first check if the directory is already in there # (inlined interpFindInAccessPath). + CheckInterp $slave namespace upvar ::safe [VarName $slave] state if {[dict exists $state(access_path,remap) $path]} { @@ -591,11 +593,15 @@ proc ::safe::AddSubDirs {pathList} { } # This procedure deletes a safe slave managed by Safe Tcl and cleans up -# associated state: +# associated state. +# - The command will also delete non-Safe-Base interpreters. +# - This is regrettable, but to avoid breaking existing code this should be +# amended at the next major revision by uncommenting "CheckInterp". proc ::safe::interpDelete {slave} { Log $slave "About to delete" NOTICE + # CheckInterp $slave namespace upvar ::safe [VarName $slave] state # When an interpreter is deleted with [interp delete], any sub-interpreters diff --git a/tests/safe.test b/tests/safe.test index 1415b09..f6d1826 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -94,6 +94,8 @@ test safe-2.2 {creating interpreters, should have no aliases} -setup { a aliases } -cleanup { safe::interpDelete a + # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters + # is regrettable and should be removed at the next major revision. } -result "" test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -setup { catch {safe::interpDelete a} @@ -143,6 +145,8 @@ test safe-4.1 {safe::interpDelete} -setup { } -body { interp create a safe::interpDelete a + # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters + # is regrettable and should be removed at the next major revision. } -result "" test safe-4.2 {safe::interpDelete, indirectly} -setup { catch {safe::interpDelete a} @@ -150,6 +154,8 @@ test safe-4.2 {safe::interpDelete, indirectly} -setup { interp create a a alias exit safe::interpDelete a a eval exit + # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters + # is regrettable and should be removed at the next major revision. } -result "" test safe-4.5 {safe::interpDelete} -setup { catch {safe::interpDelete a} -- cgit v0.12 From 7f6ef9991b5e56cb237fd047aa75c1c012014a3a Mon Sep 17 00:00:00 2001 From: kjnash Date: Wed, 22 Jul 2020 19:07:30 +0000 Subject: Whitespace changes only. --- tests/safe.test | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/tests/safe.test b/tests/safe.test index f6d1826..bcb33d7 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -285,7 +285,6 @@ test safe-5.6 {example modules packages, test in master interpreter, append to p catch {namespace delete ::mod1} } -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2} - # test safe interps 'information leak' proc SafeEval {script} { # Helper procedure that ensures the safe interp is cleaned up even if @@ -317,7 +316,7 @@ rename SafeEval {} # leaking infos, but they still do... # high level general test -# Use example packages not http1.0 +# Use example packages not http1.0 etc test safe-7.1 {tests that everything works at high level} -setup { set tmpAutoPath $::auto_path lappend ::auto_path [file join $TestsDir auto0] @@ -1012,7 +1011,7 @@ 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 --\ + list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ [lsort [list $path3 $path4 $path5]] -- $modsB -- \ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ $out0 $out1 $out2 @@ -1079,7 +1078,7 @@ 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 --\ + list [lsort [list $path0 $path1 $path2]] -- $modsA -- \ [lsort [list $path3 $path4 $path5]] -- $modsB -- \ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \ $out0 $out1 $out2 @@ -1543,7 +1542,7 @@ test safe-15.1 {safe file ensemble does not surprise code} -setup { unset -nocomplain msg interp delete $i } -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}} -test safe-15.1.1 {safe file ensemble does not surprise code} -setup { +test safe-15.2 {safe file ensemble does not surprise code} -setup { set i [interp create -safe] } -body { set result [expr {"file" in [interp hidden $i]}] @@ -1659,12 +1658,11 @@ test safe-16.8 {Bug 3529949: defang ~user in paths used by AliasGlob (2)} -setup unset user } -result {~USER} +# cleanup set ::auto_path $SaveAutoPath unset SaveAutoPath TestsDir PathMapp rename mapList {} rename mapAndSortList {} - -# cleanup ::tcltest::cleanupTests return -- cgit v0.12 From 0e59966ac59400d43816bc360c74e5b9dfb49493 Mon Sep 17 00:00:00 2001 From: kjnash Date: Thu, 23 Jul 2020 13:26:02 +0000 Subject: Improvements to removal of stale package data - bugfix for 1f63efa537 and 319e438f7f --- library/safe.tcl | 40 +++++++++++++--------------------------- 1 file changed, 13 insertions(+), 27 deletions(-) diff --git a/library/safe.tcl b/library/safe.tcl index 3e8c2c6..1c46978 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -219,7 +219,7 @@ proc ::safe::interpConfigure {args} { set deleteHook $state(cleanupHook) } # we can now reconfigure : - set slave_tm_rel [InterpSetConfig $slave $accessPath $statics $nested $deleteHook] + InterpSetConfig $slave $accessPath $statics $nested $deleteHook # auto_reset the slave (to completly synch the new access_path) if {$doreset} { if {[catch {::interp eval $slave {auto_reset}} msg]} { @@ -235,19 +235,18 @@ proc ::safe::interpConfigure {args} { ::tcl::tm::add {*}[lreverse $state(tm_path_slave)]] } - # Wherever possible, refresh package/module data. - # - Ideally [package ifneeded $pkg $ver {}] would clear the - # stale data from the interpreter, but instead it sets a - # nonsense empty script. - # - We cannot purge stale package data, but we can overwrite - # it where we have fresh data. Any remaining stale data will - # do no harm but the error messages may be cryptic. - ::interp eval $slave [list catch {package require NOEXIST}] - foreach rel $slave_tm_rel { - set cmd [list package require [string map {/ ::} $rel]::NOEXIST] - ::interp eval $slave [list catch $cmd] + # Remove stale "package ifneeded" data for non-loaded packages. + # - Not for loaded packages, because "package forget" erases + # data from "package provide" as well as "package ifneeded". + # - This is OK because the script cannot reload any version of + # the package unless it first does "package forget". + foreach pkg [::interp eval $slave {package names}] { + if {[::interp eval $slave [list package provide $pkg]] eq ""} { + ::interp eval $slave [list package forget $pkg] + } } } + return } } } @@ -356,8 +355,6 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { set map_access_path {} set remap_access_path {} set slave_tm_path {} - set slave_tm_roots {} - set slave_tm_rel {} set i 0 foreach dir $access_path { @@ -384,7 +381,6 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { # Later passes handle subdirectories, which belong in the # access path but not in the module path. lappend slave_tm_path [dict get $remap_access_path $dir] - lappend slave_tm_roots [file normalize $dir] [file normalize $dir] } continue } @@ -400,7 +396,6 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { # Later passes handle subdirectories, which belong in the # access path but not in the module path. lappend slave_tm_path $token - lappend slave_tm_roots [file normalize $dir] [file normalize $dir] } incr i @@ -410,16 +405,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { # 'platform::shell', which translate into # 'platform/shell-X.tm', i.e arbitrarily deep # subdirectories. - set next [glob -nocomplain -directory $dir -type d *] - lappend morepaths {*}$next - foreach sub $next { - lappend slave_tm_roots [file normalize $sub] [dict get $slave_tm_roots $dir] - set lenny [string length [dict get $slave_tm_roots $dir]] - set relpath [string range [file normalize $sub] $lenny+1 end] - if {$relpath ni $slave_tm_rel} { - lappend slave_tm_rel $relpath - } - } + lappend morepaths {*}[glob -nocomplain -directory $dir -type d *] } set firstpass 0 } @@ -435,7 +421,7 @@ proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} { set state(cleanupHook) $deletehook SyncAccessPath $slave - return $slave_tm_rel + return } # -- cgit v0.12 -- cgit v0.12 From cc21b0be2ad2d9c16af8d9dbdf188110479ebfc7 Mon Sep 17 00:00:00 2001 From: kjnash Date: Wed, 12 Aug 2020 09:20:56 +0000 Subject: Bugfixes to the earlier fix of bug cb0373bb33, which broke HTTP/1.0 transactions in which the server indicates neither a Content-Length nor that it will close the socket on completion ("Connection: close"). The HTTP/1.1 rule is that the response header "Connection", if absent, must default to "keep-alive"; but this rule does not apply to HTTP/1.0. Add test http11-3.4 and bump version to 2.9.4. --- library/http/http.tcl | 40 ++++++++++++++++++++++++++++------------ library/http/pkgIndex.tcl | 2 +- tests/http11.test | 27 +++++++++++++++++++++++++++ tests/httpd11.tcl | 13 +++++++++++-- unix/Makefile.in | 4 ++-- win/Makefile.in | 4 ++-- 6 files changed, 71 insertions(+), 19 deletions(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index f9ec8ca..8b5d686 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -11,7 +11,7 @@ package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.9.3 +package provide http 2.9.4 namespace eval http { # Allow resourcing to not clobber existing data @@ -966,6 +966,18 @@ proc http::geturl {url args} { set state(-pipeline) $http(-pipeline) } + # We cannot handle chunked encodings with -handler, so force HTTP/1.0 + # until we can manage this. + if {[info exists state(-handler)]} { + set state(-protocol) 1.0 + } + + # RFC 7320 A.1 - HTTP/1.0 Keep-Alive is problematic. We do not support it. + if {$state(-protocol) eq "1.0"} { + set state(connection) close + set state(-keepalive) 0 + } + # See if we are supposed to use a previously opened channel. # - In principle, ANY call to http::geturl could use a previously opened # channel if it is available - the "Connection: keep-alive" header is a @@ -1338,11 +1350,6 @@ proc http::Connected {token proto phost srvurl} { if {[info exists state(-method)] && ($state(-method) ne "")} { set how $state(-method) } - # We cannot handle chunked encodings with -handler, so force HTTP/1.0 - # until we can manage this. - if {[info exists state(-handler)]} { - set state(-protocol) 1.0 - } set accept_types_seen 0 Log ^B$tk begin sending request - token $token @@ -1361,7 +1368,7 @@ proc http::Connected {token proto phost srvurl} { puts $sock "Host: $host:$port" } puts $sock "User-Agent: $http(-useragent)" - if {($state(-protocol) >= 1.0) && $state(-keepalive)} { + if {($state(-protocol) > 1.0) && $state(-keepalive)} { # Send this header, because a 1.1 server is not compelled to treat # this as the default. puts $sock "Connection: keep-alive" @@ -1369,9 +1376,17 @@ proc http::Connected {token proto phost srvurl} { if {($state(-protocol) > 1.0) && !$state(-keepalive)} { puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1 } - if {[info exists phost] && ($phost ne "") && $state(-keepalive)} { - puts $sock "Proxy-Connection: Keep-Alive" - } + if {($state(-protocol) < 1.1)} { + # RFC7230 A.1 + # Some server implementations of HTTP/1.0 have a faulty + # implementation of RFC 2068 Keep-Alive. + # Don't leave this to chance. + # For HTTP/1.0 we have already "set state(connection) close" + # and "state(-keepalive) 0". + puts $sock "Connection: close" + } + # RFC7230 A.1 - "clients are encouraged not to send the + # Proxy-Connection header field in any requests" set accept_encoding_seen 0 set content_type_seen 0 dict for {key value} $state(-headers) { @@ -2702,15 +2717,16 @@ proc http::Event {sock token} { # therefore "keep-alive". set tmpHeader keep-alive } else { - set tmpHeader keep-alive + set tmpResult keep-alive set tmpCsl [split $tmpHeader ,] # Optional whitespace either side of separator. foreach el $tmpCsl { if {[string trim $el] eq {close}} { - set tmpHeader close + set tmpResult close break } } + set tmpHeader $tmpResult } set state(connection) $tmpHeader } diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 43cd86b..1cc8f46 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.6-]} {return} -package ifneeded http 2.9.3 [list tclPkgSetup $dir http 2.9.3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded http 2.9.4 [list tclPkgSetup $dir http 2.9.4 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/tests/http11.test b/tests/http11.test index 762788e..240bfef 100644 --- a/tests/http11.test +++ b/tests/http11.test @@ -626,6 +626,33 @@ test http11-3.3 "-handler,keepalive,chunked" -setup { halt_httpd } -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} +# http11-3.4 +# This test is a blatant attempt to confuse the client by instructing the server +# to send neither "Connection: close" nor "Content-Length" when in non-chunked +# mode. +# The client has no way to know the response-body is complete unless the +# server signals this by closing the connection. +# In an HTTP/1.1 response the absence of "Connection: close" means +# "Connection: keep-alive", i.e. the server will keep the connection +# open. In HTTP/1.0 this is not the case, and this is a test that +# the Tcl client assumes "Connection: close" by default in HTTP/1.0. +test http11-3.4 "-handler,close,identity; HTTP/1.0 server does not send Connection: close header or Content-Length" -setup { + variable httpd [create_httpd] + set testdata "" +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1&nosendclose=any \ + -timeout 10000 -handler [namespace code [list handler testdata]]] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ + [meta $tok connection] [meta $tok content-encoding] \ + [meta $tok transfer-encoding] \ + [expr {[file size testdoc.html]-[string length $testdata]}] +} -cleanup { + http::cleanup $tok + unset -nocomplain testdata + halt_httpd +} -result {ok {HTTP/1.0 200 OK} ok {} {} {} 0} + test http11-4.0 "normal post request" -setup { variable httpd [create_httpd] } -body { diff --git a/tests/httpd11.tcl b/tests/httpd11.tcl index 7880494..0b02319 100644 --- a/tests/httpd11.tcl +++ b/tests/httpd11.tcl @@ -170,14 +170,19 @@ proc Service {chan addr port} { set close 1 } + set nosendclose 0 foreach pair [split $query &] { if {[scan $pair {%[^=]=%s} key val] != 2} {set val ""} switch -exact -- $key { + nosendclose {set nosendclose 1} close {set close 1 ; set transfer 0} transfer {set transfer $val} content-type {set type $val} } } + if {$protocol eq "HTTP/1.1"} { + set nosendclose 0 + } chan configure $chan -buffering line -encoding iso8859-1 -translation crlf Puts $chan "$protocol $code" @@ -186,12 +191,16 @@ proc Service {chan addr port} { if {$req eq "POST"} { Puts $chan [format "x-query-length: %d" [string length $query]] } - if {$close} { + if {$close && (!$nosendclose)} { Puts $chan "connection: close" } Puts $chan "x-requested-encodings: [dict get? $meta accept-encoding]" - if {$encoding eq "identity"} { + if {$encoding eq "identity" && (!$nosendclose)} { Puts $chan "content-length: [string length $data]" + } elseif {$encoding eq "identity"} { + # This is a blatant attempt to confuse the client by sending neither + # "Connection: close" nor "Content-Length" when in non-chunked mode. + # See test http11-3.4. } else { Puts $chan "content-encoding: $encoding" } diff --git a/unix/Makefile.in b/unix/Makefile.in index 3e0dd1e..07ce3b7 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -944,8 +944,8 @@ install-libraries: libraries do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.9.3 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.3.tm"; + @echo "Installing package http 2.9.4 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.4.tm"; @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"; @for i in $(TOP_DIR)/library/opt/*.tcl ; \ do \ diff --git a/win/Makefile.in b/win/Makefile.in index 7c0db47..110f7bf 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -719,8 +719,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.9.3 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.3.tm"; + @echo "Installing package http 2.9.4 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.4.tm"; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ -- cgit v0.12 -- cgit v0.12 From 06a30a3a2acfa22ae71c137e7abb28e61748f496 Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 24 Aug 2020 14:28:22 +0000 Subject: Fix for http bug c2dc1da315. Add tests. Add detail about -handler to http(n). Bump version to 2.9.5. --- doc/http.n | 4 ++ library/http/http.tcl | 46 +++++++++++- library/http/pkgIndex.tcl | 2 +- tests/http11.test | 178 ++++++++++++++++++++++++++++++++++++++++++++++ unix/Makefile.in | 4 +- win/Makefile.in | 4 +- 6 files changed, 231 insertions(+), 7 deletions(-) diff --git a/doc/http.n b/doc/http.n index e8c8c90..26bf943 100644 --- a/doc/http.n +++ b/doc/http.n @@ -250,6 +250,10 @@ proc httpHandlerCallback {socket token} { return $nbytes } .CE +.PP +The \fBhttp::geturl\fR code for the \fB-handler\fR option is not compatible with either compression or chunked transfer-encoding. If \fB-handler\fR is specified, then to work around these issues \fBhttp::geturl\fR will reduce the HTTP protocol to 1.0, and override the \fB-zip\fR option (i.e. it will not send the header "\fBAccept-Encoding: gzip,deflate,compress\fR"). +.PP +If options \fB-handler\fR and \fB-channel\fR are used together, the handler is responsible for copying the data from the HTTP socket to the specified channel. The name of the channel is available to the handler as element \fB-channel\fR of the token array. .RE .TP \fB\-headers\fR \fIkeyvaluelist\fR diff --git a/library/http/http.tcl b/library/http/http.tcl index 8b5d686..9d3e5ca 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -11,7 +11,7 @@ package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.9.4 +package provide http 2.9.5 namespace eval http { # Allow resourcing to not clobber existing data @@ -1646,9 +1646,51 @@ proc http::ReceiveResponse {token} { Log ^D$tk begin receiving response - token $token coroutine ${token}EventCoroutine http::Event $sock $token - fileevent $sock readable ${token}EventCoroutine + if {[info exists state(-handler)] || [info exists state(-progress)]} { + fileevent $sock readable [list http::EventGateway $sock $token] + } else { + fileevent $sock readable ${token}EventCoroutine + } + return } + +# http::EventGateway +# +# Bug [c2dc1da315]. +# - Recursive launch of the coroutine can occur if a -handler or -progress +# callback is used, and the callback command enters the event loop. +# - To prevent this, the fileevent "binding" is disabled while the +# coroutine is in flight. +# - If a recursive call occurs despite these precautions, it is not +# trapped and discarded here, because it is better to report it as a +# bug. +# - Although this solution is believed to be sufficiently general, it is +# used only if -handler or -progress is specified. In other cases, +# the coroutine is called directly. + +proc http::EventGateway {sock token} { + variable $token + upvar 0 $token state + fileevent $sock readable {} + catch {${token}EventCoroutine} res opts + if {[info commands ${token}EventCoroutine] ne {}} { + # The coroutine can be deleted by completion (a non-yield return), by + # http::Finish (when there is a premature end to the transaction), by + # http::reset or http::cleanup, or if the caller set option -channel + # but not option -handler: in the last case reading from the socket is + # now managed by commands ::http::Copy*, http::ReceiveChunked, and + # http::make-transformation-chunked. + # + # Catch in case the coroutine has closed the socket. + catch {fileevent $sock readable [list http::EventGateway $sock $token]} + } + + # If there was an error, re-throw it. + return -options $opts $res +} + + # http::NextPipelinedWrite # # - Connecting a socket to a token for writing is done by this command and by diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 1cc8f46..74c4841 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.6-]} {return} -package ifneeded http 2.9.4 [list tclPkgSetup $dir http 2.9.4 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded http 2.9.5 [list tclPkgSetup $dir http 2.9.5 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/tests/http11.test b/tests/http11.test index 240bfef..989b00f 100644 --- a/tests/http11.test +++ b/tests/http11.test @@ -280,6 +280,20 @@ test http11-1.13 "normal, 1.1 and keepalive as server default, no zip" -setup { # ------------------------------------------------------------------------- +proc progress {var token total current} { + upvar #0 $var log + set log [list $current $total] + return +} + +proc progressPause {var token total current} { + upvar #0 $var log + set log [list $current $total] + after 100 set ::WaitHere 0 + vwait ::WaitHere + return +} + test http11-2.0 "-channel" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] @@ -376,6 +390,58 @@ test http11-2.4 "-channel,encoding identity" -setup { halt_httpd } -result {ok {HTTP/1.1 200 OK} ok close {} chunked} +test http11-2.4.1 "-channel,encoding identity with -progress" -setup { + variable httpd [create_httpd] + set chan [open [makeFile {} testfile.tmp] wb+] + set logdata "" +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 5000 -channel $chan \ + -headers {accept-encoding identity} \ + -progress [namespace code [list progress logdata]]] + + http::wait $tok + seek $chan 0 + set data [read $chan] + list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ + [meta $tok connection] [meta $tok content-encoding]\ + [meta $tok transfer-encoding] \ + [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ + [expr {[lindex $logdata 0] - [string length $data]}] +} -cleanup { + http::cleanup $tok + close $chan + removeFile testfile.tmp + halt_httpd + unset -nocomplain logdata data +} -result {ok {HTTP/1.1 200 OK} ok close {} chunked 0 0} + +test http11-2.4.2 "-channel,encoding identity with -progress progressPause enters event loop" -constraints knownBug -setup { + variable httpd [create_httpd] + set chan [open [makeFile {} testfile.tmp] wb+] + set logdata "" +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html \ + -timeout 5000 -channel $chan \ + -headers {accept-encoding identity} \ + -progress [namespace code [list progressPause logdata]]] + + http::wait $tok + seek $chan 0 + set data [read $chan] + list [http::status $tok] [http::code $tok] [check_crc $tok $data]\ + [meta $tok connection] [meta $tok content-encoding]\ + [meta $tok transfer-encoding] \ + [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ + [expr {[lindex $logdata 0] - [string length $data]}] +} -cleanup { + http::cleanup $tok + close $chan + removeFile testfile.tmp + halt_httpd + unset -nocomplain logdata data ::WaitHere +} -result {ok {HTTP/1.1 200 OK} ok close {} chunked 0 0} + test http11-2.5 "-channel,encoding unsupported" -setup { variable httpd [create_httpd] set chan [open [makeFile {} testfile.tmp] wb+] @@ -555,6 +621,16 @@ proc handler {var sock token} { return [string length $chunk] } +proc handlerPause {var sock token} { + upvar #0 $var data + set chunk [read $sock] + append data $chunk + #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])" + after 100 set ::WaitHere 0 + vwait ::WaitHere + return [string length $chunk] +} + test http11-3.0 "-handler,close,identity" -setup { variable httpd [create_httpd] set testdata "" @@ -653,6 +729,108 @@ test http11-3.4 "-handler,close,identity; HTTP/1.0 server does not send Connecti halt_httpd } -result {ok {HTTP/1.0 200 OK} ok {} {} {} 0} +# It is not forbidden for a handler to enter the event loop. +test http11-3.5 "-handler,close,identity as http11-3.0 but handlerPause enters event loop" -setup { + variable httpd [create_httpd] + set testdata "" +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -timeout 10000 -handler [namespace code [list handlerPause testdata]]] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ + [meta $tok connection] [meta $tok content-encoding] \ + [meta $tok transfer-encoding] \ + [expr {[file size testdoc.html]-[string length $testdata]}] +} -cleanup { + http::cleanup $tok + unset -nocomplain testdata ::WaitHere + halt_httpd +} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0} + +test http11-3.6 "-handler,close,identity as http11-3.0 but with -progress" -setup { + variable httpd [create_httpd] + set testdata "" + set logdata "" +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -timeout 10000 -handler [namespace code [list handler testdata]] \ + -progress [namespace code [list progress logdata]]] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ + [meta $tok connection] [meta $tok content-encoding] \ + [meta $tok transfer-encoding] \ + [expr {[file size testdoc.html]-[string length $testdata]}] \ + [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ + [expr {[lindex $logdata 0] - [string length $testdata]}] +} -cleanup { + http::cleanup $tok + unset -nocomplain testdata logdata ::WaitHere + halt_httpd +} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0} + +test http11-3.7 "-handler,close,identity as http11-3.0 but with -progress progressPause enters event loop" -setup { + variable httpd [create_httpd] + set testdata "" + set logdata "" +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -timeout 10000 -handler [namespace code [list handler testdata]] \ + -progress [namespace code [list progressPause logdata]]] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\ + [meta $tok connection] [meta $tok content-encoding] \ + [meta $tok transfer-encoding] \ + [expr {[file size testdoc.html]-[string length $testdata]}] \ + [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ + [expr {[lindex $logdata 0] - [string length $testdata]}] +} -cleanup { + http::cleanup $tok + unset -nocomplain testdata logdata ::WaitHere + halt_httpd +} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0} + +test http11-3.8 "close,identity no -handler but with -progress" -setup { + variable httpd [create_httpd] + set logdata "" +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -timeout 10000 \ + -progress [namespace code [list progress logdata]] \ + -headers {accept-encoding {}}] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok]\ + [meta $tok connection] [meta $tok content-encoding] \ + [meta $tok transfer-encoding] \ + [expr {[file size testdoc.html]-[string length [http::data $tok]]}] \ + [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ + [expr {[lindex $logdata 0] - [string length [http::data $tok]]}] +} -cleanup { + http::cleanup $tok + unset -nocomplain logdata ::WaitHere + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0} + +test http11-3.9 "close,identity no -handler but with -progress progressPause enters event loop" -setup { + variable httpd [create_httpd] + set logdata "" +} -body { + set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \ + -timeout 10000 \ + -progress [namespace code [list progressPause logdata]] \ + -headers {accept-encoding {}}] + http::wait $tok + list [http::status $tok] [http::code $tok] [check_crc $tok]\ + [meta $tok connection] [meta $tok content-encoding] \ + [meta $tok transfer-encoding] \ + [expr {[file size testdoc.html]-[string length [http::data $tok]]}] \ + [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \ + [expr {[lindex $logdata 0] - [string length [http::data $tok]]}] +} -cleanup { + http::cleanup $tok + unset -nocomplain logdata ::WaitHere + halt_httpd +} -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0} + test http11-4.0 "normal post request" -setup { variable httpd [create_httpd] } -body { diff --git a/unix/Makefile.in b/unix/Makefile.in index 07ce3b7..87f0844 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -944,8 +944,8 @@ install-libraries: libraries do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.9.4 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.4.tm"; + @echo "Installing package http 2.9.5 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.5.tm"; @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"; @for i in $(TOP_DIR)/library/opt/*.tcl ; \ do \ diff --git a/win/Makefile.in b/win/Makefile.in index 110f7bf..dee6656 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -719,8 +719,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.9.4 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.4.tm"; + @echo "Installing package http 2.9.5 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.9.5.tm"; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ -- cgit v0.12 From 171bea3624e84c0fe616ac8bef5d7e8138bdc359 Mon Sep 17 00:00:00 2001 From: kjnash Date: Mon, 24 Aug 2020 14:35:37 +0000 Subject: Try another Travis build --- tests/safe-stock86.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/safe-stock86.test b/tests/safe-stock86.test index 2fbe108..ccfdd3f 100644 --- a/tests/safe-stock86.test +++ b/tests/safe-stock86.test @@ -2,8 +2,8 @@ # # This file contains tests for safe Tcl that were previously in the file # safe.test, and use files and packages of stock Tcl 8.6 to perform the tests. -# These files may be changed or disappear in future revisions of Tcl, for -# example package http 1.0 will be removed from Tcl 8.7. +# These files may be changed or disappear in future revisions of Tcl, +# for example package http 1.0 will be removed from Tcl 8.7. # # The tests are replaced in safe.tcl with tests that use files provided in the # tests directory. Test numbering is for comparison with similar tests in -- cgit v0.12 From 3b1ca15e0739a1650dbc9c0de1429299326078ee Mon Sep 17 00:00:00 2001 From: kjnash Date: Thu, 27 Aug 2020 15:50:24 +0000 Subject: Provide error message if failed load does not. --- library/safe.tcl | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/library/safe.tcl b/library/safe.tcl index 1c46978..c0a5dc6 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -1068,6 +1068,13 @@ proc ::safe::AliasLoad {slave file args} { try { return [::interp invokehidden $slave load $file $package $target] } on error msg { + # Some packages return no error message. + set msg0 "Load of binary library for package $package failed" + if {$msg eq {}} { + set msg $msg0 + } else { + set msg "$msg0: $msg" + } Log $slave $msg return -code error $msg } -- cgit v0.12 From 953e3ea89962393c4b65866feb0f3d38f4bc8b14 Mon Sep 17 00:00:00 2001 From: kjnash Date: Fri, 28 Aug 2020 01:03:23 +0000 Subject: Update safe.test for new error message. --- library/safe.tcl | 2 +- tests/safe.test | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/library/safe.tcl b/library/safe.tcl index c0a5dc6..352b302 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -1069,7 +1069,7 @@ proc ::safe::AliasLoad {slave file args} { return [::interp invokehidden $slave load $file $package $target] } on error msg { # Some packages return no error message. - set msg0 "Load of binary library for package $package failed" + set msg0 "load of binary library for package $package failed" if {$msg eq {}} { set msg $msg0 } else { diff --git a/tests/safe.test b/tests/safe.test index bcb33d7..eba6057 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -1167,7 +1167,7 @@ test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup { interp eval $i {load {} Safepkg1} } -returnCodes error -cleanup { safe::interpDelete $i -} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} +} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup { set i [safe::interpCreate] } -body { @@ -1176,7 +1176,7 @@ test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup { } -returnCodes ok -cleanup { unset -nocomplain m o safe::interpDelete $i -} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure +} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure invoked from within "load {} Safepkg1" invoked from within @@ -1199,7 +1199,7 @@ test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints Tcl interp eval $i {interp create x; load {} Safepkg1 x} } -returnCodes error -cleanup { safe::interpDelete $i -} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} +} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure} test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body { set i [safe::interpCreate -nestedloadok] catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o @@ -1207,7 +1207,7 @@ test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints T } -returnCodes ok -cleanup { unset -nocomplain m o safe::interpDelete $i -} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure +} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure invoked from within "load {} Safepkg1 x" invoked from within -- cgit v0.12 From 4af0efa4cb10780f9c7d391eb66fe1c3367872d2 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 28 Aug 2020 14:02:50 +0000 Subject: tests/regexp.test: added missing test that cover indices if running on string containing multi-byte utf-8 chars (de/ru, byte offsets != char offsets) --- tests/regexp.test | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/regexp.test b/tests/regexp.test index 362f425..99113ce 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -156,6 +156,10 @@ test regexp-3.7 {getting substrings back from regexp} { set foo 1; set f2 1; set f3 1; set f4 1 list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4 } {1 {1 2} {1 1} {-1 -1} {2 2}} +test regexp-3.8 {-indices by multi-byte utf-8} { + regexp -inline -indices {(\w+)-(\w+)} \ + "gr\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442" +} {{0 10} {0 3} {5 10}} test regexp-4.1 {-nocase option to regexp} { regexp -nocase foo abcFOo -- cgit v0.12 From be42098b827423520078e2cb5150275a3a8540e2 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 28 Aug 2020 15:01:23 +0000 Subject: tests/regexp.test: more tests for -indices by multi-byte utf-8 (considering -start position now) --- tests/regexp.test | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/tests/regexp.test b/tests/regexp.test index 99113ce..d2bdf7b 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -156,10 +156,17 @@ test regexp-3.7 {getting substrings back from regexp} { set foo 1; set f2 1; set f3 1; set f4 1 list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4 } {1 {1 2} {1 1} {-1 -1} {2 2}} -test regexp-3.8 {-indices by multi-byte utf-8} { +test regexp-3.8a {-indices by multi-byte utf-8} { regexp -inline -indices {(\w+)-(\w+)} \ "gr\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442" } {{0 10} {0 3} {5 10}} +test regexp-3.8b {-indices by multi-byte utf-8, from -start position} { + list\ + [regexp -inline -indices -start 3 {(\w+)-(\w+)} \ + "gr\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442"] \ + [regexp -inline -indices -start 4 {(\w+)-(\w+)} \ + "gr\u00FC\u00DF-\u043F\u0440\u0438\u0432\u0435\u0442"] +} {{{3 10} {3 3} {5 10}} {}} test regexp-4.1 {-nocase option to regexp} { regexp -nocase foo abcFOo -- cgit v0.12