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