# 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}]}]
testConstraint AutoSyncDefined 1
# 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} -- {}}
test safe-stock86-7.5 {tests positive and negative module loading with conventional AutoPathSync} -setup {
set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}]
if {$SyncExists} {
set SyncVal_TMP [safe::setAutoPathSync]
safe::setAutoPathSync 1
}
set i [safe::interpCreate]
interp eval $i {
package forget platform::shell
package forget platform
catch {namespace delete ::platform}
# for platform::shell use mod1::test1
}
} -body {
# Should raise an error (module ancestor directory issue)
set code1 [catch {interp eval $i {package require shell}} msg1]
# Should not raise an error
set code2 [catch {interp eval $i {package require platform::shell}} msg2]
return [list $code1 $msg1 $code2]
} -cleanup {
safe::interpDelete $i
if {$SyncExists} {
safe::setAutoPathSync $SyncVal_TMP
}
} -result {1 {can't find package shell} 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
### 18. Tests for AutoSyncDefined without conventional AutoPathSync, i.e. with AutoPathSync off.
test safe-stock86-18.1 {cf. safe-stock86-7.1 - tests that everything works at high level without conventional AutoPathSync} -constraints AutoSyncDefined -setup {
# All ::safe commands are loaded at start of file.
set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}]
if {$SyncExists} {
set SyncVal_TMP [safe::setAutoPathSync]
safe::setAutoPathSync 0
} else {
error {This test is meaningful only if the command ::safe::setAutoPathSync is defined}
}
# Without AutoPathSync, we need a more complete auto_path,
# because the slave will use the same value.
set lib1 [info library]
set lib2 [file dirname $lib1]
set ::auto_TMP $::auto_path
set ::auto_path [list $lib1 $lib2]
set i [safe::interpCreate]
set ::auto_path $::auto_TMP
} -body {
# 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 1}]
# no error shall occur:
interp eval $i {http_config}
set v
} -cleanup {
safe::interpDelete $i
if {$SyncExists} {
safe::setAutoPathSync $SyncVal_TMP
}
} -result 1.0
test safe-stock86-18.2 {cf. safe-stock86-7.2 - tests specific path and interpFind/AddToAccessPath without conventional AutoPathSync} -constraints AutoSyncDefined -setup {
# All ::safe commands are loaded at start of file.
set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}]
if {$SyncExists} {
set SyncVal_TMP [safe::setAutoPathSync]
safe::setAutoPathSync 0
} else {
error {This test is meaningful only if the command ::safe::setAutoPathSync is defined}
}
} -body {
set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
set auto1 [interp eval $i {set ::auto_path}]
interp eval $i {set ::auto_path [list {$p(:0:)}]}
# 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"]
# an error shall occur (http is not anymore in the secure 0-level
# provided deep path)
list $auto1 $token1 $token2 \
[catch {interp eval $i {package require http 1}} msg] $msg \
[safe::interpConfigure $i]\
[safe::interpDelete $i]
} -cleanup {
if {$SyncExists} {
safe::setAutoPathSync $SyncVal_TMP
}
} -match glob -result "{} {\$p(:0:)} {\$p(:*:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library */dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {} -autoPath [list $tcl_library]} {}"
test safe-stock86-18.4 {cf. safe-stock86-7.4 - tests specific path and positive search and auto_path without conventional AutoPathSync} -constraints AutoSyncDefined -setup {
# All ::safe commands are loaded at start of file.
set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}]
if {$SyncExists} {
set SyncVal_TMP [safe::setAutoPathSync]
safe::setAutoPathSync 0
} else {
error {This test is meaningful only if the command ::safe::setAutoPathSync is defined}
}
} -body {
set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
# should not have been set by Safe Base:
set auto1 [interp eval $i {set ::auto_path}]
interp eval $i {set ::auto_path [list {$p(:0:)}]}
# should not add anything (p0)
set token1 [safe::interpAddToAccessPath $i [info library]]
# should add as p* (not p1 if master has a module path)
set token2 [safe::interpAddToAccessPath $i [file join [info library] http1.0]]
# should not have been changed by Safe Base:
set auto2 [interp eval $i {set ::auto_path}]
# This time, unlike test safe-stock86-18.2 and the try above, http 1.0 should be found:
list $auto1 $auto2 $token1 $token2 \
[catch {interp eval $i {package require http 1}} msg] $msg \
[safe::interpConfigure $i]\
[safe::interpDelete $i]
} -cleanup {
if {$SyncExists} {
safe::setAutoPathSync $SyncVal_TMP
}
} -match glob -result "{} {{\$p(:0:)}} {\$p(:0:)} {\$p(:*:)} 0 1.0 {-accessPath {[list $tcl_library *$tcl_library/http1.0]} -statics 0 -nested 1 -deleteHook {} -autoPath [list $tcl_library]} {}"
test safe-stock86-18.5 {cf. safe-stock86-7.5 - tests positive and negative module loading without conventional AutoPathSync} -setup {
set SyncExists [expr {[info commands ::safe::setAutoPathSync] ne {}}]
if {$SyncExists} {
set SyncVal_TMP [safe::setAutoPathSync]
safe::setAutoPathSync 0
} else {
error {This test is meaningful only if the command ::safe::setAutoPathSync is defined}
}
set i [safe::interpCreate]
interp eval $i {
package forget platform::shell
package forget platform
catch {namespace delete ::platform}
}
} -body {
# Should raise an error (tests module ancestor directory rule)
set code1 [catch {interp eval $i {package require shell}} msg1]
# Should not raise an error
set code2 [catch {interp eval $i {package require platform::shell}} msg2]
return [list $code1 $msg1 $code2]
} -cleanup {
safe::interpDelete $i
if {$SyncExists} {
safe::setAutoPathSync $SyncVal_TMP
}
} -result {1 {can't find package shell} 0}
# cleanup
set ::auto_path $SaveAutoPath
unset SaveAutoPath TestsDir PathMapp
rename mapList {}
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End: