110 lines
4.1 KiB
Plaintext
110 lines
4.1 KiB
Plaintext
# safe-stock.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.
|
||
|
||
if {"::tcltest" ni [namespace children]} {
|
||
package require tcltest 2.5
|
||
namespace import -force ::tcltest::*
|
||
}
|
||
|
||
foreach i [interp children] {
|
||
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}
|
||
|
||
# high level general test
|
||
test safe-stock-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 child works like in the parent)
|
||
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-stock-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-stock-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-stock-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-stock-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:
|