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