Merge safe-bugfixes-8-6

1 files changed, 116 insertions, 0 deletions

diff --git a/tests/safe-stock86.test b/tests/safe-stock86.test
new file mode 100644
index 0000000..ccfdd3f
--- /dev/null
+++ b/tests/safe-stock86.test
@@ -0,0 +1,116 @@
+# 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} -- {}}
+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} -- {}}
+
+# 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: