1# safe-stock.test -- 2# 3# This file contains tests for safe Tcl that were previously in the file 4# safe.test, and use files and packages of stock Tcl 8.7 to perform the tests. 5# These files may be changed or disappear in future revisions of Tcl, for 6# example package opt will eventually be removed. 7# 8# The tests are replaced in safe.tcl with tests that use files provided in the 9# tests directory. Test numbering is for comparison with similar tests in 10# safe.test. 11# 12# Sourcing this file into tcl runs the tests and generates output for errors. 13# No output means no errors were found. 14# 15# The defunct package http 1.0 was convenient for testing package loading. 16# - This file, safe-stock.test, uses packages opt and (from cookiejar) 17# tcl::idna to provide alternative tests based on stock Tcl packages. 18# - These are tests 7.1 7.2 7.4 9.11 9.13 19# - Tests 7.[124], 9.1[13] use "package require opt". 20# - Tests 9.1[13] also use "package require tcl::idna". 21# - The corresponding tests in safe.test use example packages provided in 22# subdirectory auto0 of the tests directory, which are independent of any 23# changes made to the packages provided with Tcl. 24# 25# Copyright © 1995-1996 Sun Microsystems, Inc. 26# Copyright © 1998-1999 Scriptics Corporation. 27# 28# See the file "license.terms" for information on usage and redistribution of 29# this file, and for a DISCLAIMER OF ALL WARRANTIES. 30 31if {"::tcltest" ni [namespace children]} { 32 package require tcltest 2.5 33 namespace import -force ::tcltest::* 34} 35 36foreach i [interp children] { 37 interp delete $i 38} 39 40# When using package opt for testing positive/negative package search: 41# - The directory location and the error message depend on whether 42# and how the package is installed. 43 44# Error message for test 7.2 for "package require opt". 45if {[string match *zipfs:/* [info library]]} { 46 # pkgIndex.tcl is in [info library] 47 # file to be sourced is in [info library]/opt* 48 set pkgOptErrMsg {permission denied} 49} else { 50 # pkgIndex.tcl and file to be sourced are 51 # both in [info library]/opt* 52 set pkgOptErrMsg {can't find package opt} 53} 54 55# Directory of opt for tests 7.4, 9.10, 9.12 for "package require opt". 56if {[file exists [file join [info library] opt0.4]]} { 57 # Installed files in lib8.7/opt0.4 58 set pkgOptDir opt0.4 59} elseif {[file exists [file join [info library] opt]]} { 60 # Installed files in zipfs, or source files used by "make test" 61 set pkgOptDir opt 62} else { 63 error {cannot find opt library} 64} 65 66# Directory of cookiejar for tests 9.10, 9.12 for "package require tcl::idna". 67if {[file exists [file join [info library] cookiejar0.2]]} { 68 # Installed files in lib8.7/cookiejar0.2 69 set pkgJarDir cookiejar0.2 70} elseif {[file exists [file join [info library] cookiejar]]} { 71 # Installed files in zipfs, or source files used by "make test" 72 set pkgJarDir cookiejar 73} else { 74 error {cannot find cookiejar library} 75} 76 77set SaveAutoPath $::auto_path 78set ::auto_path [info library] 79set TestsDir [file normalize [file dirname [info script]]] 80set PathMapp {} 81lappend PathMapp [file join [info library] $pkgOptDir] TCLLIB/OPTDIR 82lappend PathMapp [file join [info library] $pkgJarDir] TCLLIB/JARDIR 83lappend PathMapp $tcl_library TCLLIB $TestsDir TESTSDIR 84 85proc mapList {map listIn} { 86 set listOut {} 87 foreach element $listIn { 88 lappend listOut [string map $map $element] 89 } 90 return $listOut 91} 92proc mapAndSortList {map listIn} { 93 set listOut {} 94 foreach element $listIn { 95 lappend listOut [string map $map $element] 96 } 97 lsort $listOut 98} 99 100# Force actual loading of the safe package because we use un-exported (and 101# thus un-autoindexed) APIs in this test result arguments: 102catch {safe::interpConfigure} 103 104# high level general test 105test safe-stock-7.1 {tests that everything works at high level, uses pkg opt} -setup { 106 set i [safe::interpCreate] 107} -body { 108 # no error shall occur: 109 # (because the default access_path shall include 1st level sub dirs so 110 # package require in a child works like in the parent) 111 set v [interp eval $i {package require opt}] 112 # no error shall occur: 113 interp eval $i {::tcl::Lempty {a list}} 114 set v 115} -cleanup { 116 safe::interpDelete $i 117} -match glob -result 0.4.* 118test safe-stock-7.2 {tests specific path and interpFind/AddToAccessPath, uses pkg opt} -setup { 119} -body { 120 set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] 121 # should not add anything (p0) 122 set token1 [safe::interpAddToAccessPath $i [info library]] 123 # should add as p* (not p1 if parent has a module path) 124 set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"] 125 # an error shall occur (opt is not anymore in the secure 0-level 126 # provided deep path) 127 set confA [safe::interpConfigure $i] 128 set mappA [mapList $PathMapp [dict get $confA -accessPath]] 129 list $token1 $token2 -- \ 130 [catch {interp eval $i {package require opt}} msg] $msg -- \ 131 $mappA -- [safe::interpDelete $i] 132} -cleanup { 133} -match glob -result "{\$p(:0:)} {\$p(:*:)} -- 1 {$pkgOptErrMsg} --\ 134 {TCLLIB */dummy/unixlike/test/path} -- {}" 135test safe-stock-7.4 {tests specific path and positive search, uses pkg opt} -setup { 136} -body { 137 set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]] 138 # should not add anything (p0) 139 set token1 [safe::interpAddToAccessPath $i [info library]] 140 # should add as p* (not p1 if parent has a module path) 141 set token2 [safe::interpAddToAccessPath $i [file join [info library] $pkgOptDir]] 142 set confA [safe::interpConfigure $i] 143 set mappA [mapList $PathMapp [dict get $confA -accessPath]] 144 # this time, unlike test safe-stock-7.2, opt should be found 145 list $token1 $token2 -- \ 146 [catch {interp eval $i {package require opt}} msg] $msg -- \ 147 $mappA -- [safe::interpDelete $i] 148 # Note that the glob match elides directories (those from the module path) 149 # other than the first and last in the access path. 150} -cleanup { 151} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 0.4.* --\ 152 {TCLLIB * TCLLIB/OPTDIR} -- {}} 153 154# The following test checks whether the definition of tcl_endOfWord can be 155# obtained from auto_loading. It was previously test "safe-5.1". 156test safe-stock-9.8 {test auto-loading in safe interpreters, was safe-5.1} -setup { 157 catch {safe::interpDelete a} 158 safe::interpCreate a 159} -body { 160 interp eval a {tcl_endOfWord "" 0} 161} -cleanup { 162 safe::interpDelete a 163} -result -1 164test safe-stock-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, uses pkg opt and tcl::idna} -setup { 165} -body { 166 set i [safe::interpCreate -accessPath [list $tcl_library \ 167 [file join $tcl_library $pkgOptDir] \ 168 [file join $tcl_library $pkgJarDir]]] 169 # Inspect. 170 set confA [safe::interpConfigure $i] 171 set mappA [mapList $PathMapp [dict get $confA -accessPath]] 172 set path1 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]] 173 set path2 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]] 174 175 # Load pkgIndex.tcl data. 176 catch {interp eval $i {package require NOEXIST}} 177 178 # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}. 179 # This has no effect because the records in Pkg of these directories were from access as children of {$p(:0:)}. 180 safe::interpConfigure $i -accessPath [list $tcl_library \ 181 [file join $tcl_library $pkgJarDir] \ 182 [file join $tcl_library $pkgOptDir]] 183 # Inspect. 184 set confB [safe::interpConfigure $i] 185 set mappB [mapList $PathMapp [dict get $confB -accessPath]] 186 set path3 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]] 187 set path4 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]] 188 189 # Try to load the packages and run a command from each one. 190 set code3 [catch {interp eval $i {package require tcl::idna}} msg3] 191 set code4 [catch {interp eval $i {package require opt}} msg4] 192 set code5 [catch {interp eval $i {::tcl::Lempty {a list}}} msg5] 193 set code6 [catch {interp eval $i {::tcl::idna::IDNAencode example.com}} msg6] 194 195 list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \ 196 $mappA -- $mappB -- $code5 $msg5 $code6 $msg6 197} -cleanup { 198 safe::interpDelete $i 199} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 1.* 0 0.4.* --\ 200 {TCLLIB TCLLIB/OPTDIR TCLLIB/JARDIR*} --\ 201 {TCLLIB TCLLIB/JARDIR TCLLIB/OPTDIR*} --\ 202 0 0 0 example.com} 203test safe-stock-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed, uses pkg opt and tcl::idna} -setup { 204} -body { 205 set i [safe::interpCreate -accessPath [list $tcl_library \ 206 [file join $tcl_library $pkgOptDir] \ 207 [file join $tcl_library $pkgJarDir]]] 208 # Inspect. 209 set confA [safe::interpConfigure $i] 210 set mappA [mapList $PathMapp [dict get $confA -accessPath]] 211 set path1 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]] 212 set path2 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]] 213 214 # Load pkgIndex.tcl data. 215 catch {interp eval $i {package require NOEXIST}} 216 217 # Limit access path. Remove tokens {$p(:1:)} and {$p(:2:)}. 218 safe::interpConfigure $i -accessPath [list $tcl_library] 219 220 # Inspect. 221 set confB [safe::interpConfigure $i] 222 set mappB [mapList $PathMapp [dict get $confB -accessPath]] 223 set code4 [catch {::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]} path4] 224 set code5 [catch {::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]} path5] 225 226 # Try to load the packages. 227 set code3 [catch {interp eval $i {package require opt}} msg3] 228 set code6 [catch {interp eval $i {package require tcl::idna}} msg6] 229 230 list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \ 231 $mappA -- $mappB 232} -cleanup { 233 safe::interpDelete $i 234} -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\ 235 1 {* not found in access path} -- 1 1 --\ 236 {TCLLIB TCLLIB/OPTDIR TCLLIB/JARDIR*} -- {TCLLIB*}} 237 238set ::auto_path $SaveAutoPath 239unset pkgOptErrMsg pkgOptDir pkgJarDir SaveAutoPath TestsDir PathMapp 240rename mapList {} 241rename mapAndSortList {} 242# cleanup 243::tcltest::cleanupTests 244return 245 246# Local Variables: 247# mode: tcl 248# End: 249