blob: 72e9d34cc6dbae4561bfca8c216ecd73caf048ac (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
# 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} -- {}}
# Disable because http 1 is no longer present in the Tcl 8.7 distribution.
test safe-stock86-7.4 {tests specific path and positive search, uses http1.0} -constraints nonPortable -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:
|
