summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorkjnash <k.j.nash@usa.net>2020-07-13 11:22:37 (GMT)
committerkjnash <k.j.nash@usa.net>2020-07-13 11:22:37 (GMT)
commit0d59960edfba62674a912819c0328b91a02beb29 (patch)
treebb0d8f123828228d3f6a2305df06134dbab76b29
parent7f5a85dcea988eae492ef467b5b02c9cfab04186 (diff)
downloadtcl-0d59960edfba62674a912819c0328b91a02beb29.zip
tcl-0d59960edfba62674a912819c0328b91a02beb29.tar.gz
tcl-0d59960edfba62674a912819c0328b91a02beb29.tar.bz2
Add example files for use in tests/safe.test; add tests of the files themselves.
-rw-r--r--tests/auto0/auto1/file1.tcl3
-rw-r--r--tests/auto0/auto1/package1.tcl5
-rw-r--r--tests/auto0/auto1/pkgIndex.tcl11
-rw-r--r--tests/auto0/auto1/tclIndex9
-rw-r--r--tests/auto0/auto2/file2.tcl3
-rw-r--r--tests/auto0/auto2/package2.tcl5
-rw-r--r--tests/auto0/auto2/pkgIndex.tcl11
-rw-r--r--tests/auto0/auto2/tclIndex9
-rw-r--r--tests/auto0/modules/mod1/test1-1.0.tm5
-rw-r--r--tests/auto0/modules/mod2/test2-2.0.tm5
-rw-r--r--tests/auto0/modules/test0-0.5.tm5
-rw-r--r--tests/safe.test123
12 files changed, 194 insertions, 0 deletions
diff --git a/tests/auto0/auto1/file1.tcl b/tests/auto0/auto1/file1.tcl
new file mode 100644
index 0000000..bd8b92b
--- /dev/null
+++ b/tests/auto0/auto1/file1.tcl
@@ -0,0 +1,3 @@
+proc report1 {args} {
+ return ok1
+}
diff --git a/tests/auto0/auto1/package1.tcl b/tests/auto0/auto1/package1.tcl
new file mode 100644
index 0000000..32d7c56
--- /dev/null
+++ b/tests/auto0/auto1/package1.tcl
@@ -0,0 +1,5 @@
+proc HeresPackage1 {args} {
+ return OK1
+}
+
+package provide SafeTestPackage1 1.2.3
diff --git a/tests/auto0/auto1/pkgIndex.tcl b/tests/auto0/auto1/pkgIndex.tcl
new file mode 100644
index 0000000..babb6d5
--- /dev/null
+++ b/tests/auto0/auto1/pkgIndex.tcl
@@ -0,0 +1,11 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script. It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands. When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+package ifneeded SafeTestPackage1 1.2.3 [list source [file join $dir package1.tcl]]
diff --git a/tests/auto0/auto1/tclIndex b/tests/auto0/auto1/tclIndex
new file mode 100644
index 0000000..bbfa6d4
--- /dev/null
+++ b/tests/auto0/auto1/tclIndex
@@ -0,0 +1,9 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(report1) [list source [file join $dir file1.tcl]]
diff --git a/tests/auto0/auto2/file2.tcl b/tests/auto0/auto2/file2.tcl
new file mode 100644
index 0000000..5bc622f
--- /dev/null
+++ b/tests/auto0/auto2/file2.tcl
@@ -0,0 +1,3 @@
+proc report2 {args} {
+ return ok2
+}
diff --git a/tests/auto0/auto2/package2.tcl b/tests/auto0/auto2/package2.tcl
new file mode 100644
index 0000000..61774df
--- /dev/null
+++ b/tests/auto0/auto2/package2.tcl
@@ -0,0 +1,5 @@
+proc HeresPackage2 {args} {
+ return OK2
+}
+
+package provide SafeTestPackage2 2.3.4
diff --git a/tests/auto0/auto2/pkgIndex.tcl b/tests/auto0/auto2/pkgIndex.tcl
new file mode 100644
index 0000000..1022691
--- /dev/null
+++ b/tests/auto0/auto2/pkgIndex.tcl
@@ -0,0 +1,11 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script. It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands. When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+package ifneeded SafeTestPackage2 2.3.4 [list source [file join $dir package2.tcl]]
diff --git a/tests/auto0/auto2/tclIndex b/tests/auto0/auto2/tclIndex
new file mode 100644
index 0000000..9cd2a74
--- /dev/null
+++ b/tests/auto0/auto2/tclIndex
@@ -0,0 +1,9 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(report2) [list source [file join $dir file2.tcl]]
diff --git a/tests/auto0/modules/mod1/test1-1.0.tm b/tests/auto0/modules/mod1/test1-1.0.tm
new file mode 100644
index 0000000..927fa6f
--- /dev/null
+++ b/tests/auto0/modules/mod1/test1-1.0.tm
@@ -0,0 +1,5 @@
+namespace eval mod1::test1 {}
+
+proc mod1::test1::try1 args {
+ return res1
+}
diff --git a/tests/auto0/modules/mod2/test2-2.0.tm b/tests/auto0/modules/mod2/test2-2.0.tm
new file mode 100644
index 0000000..b5cd45b
--- /dev/null
+++ b/tests/auto0/modules/mod2/test2-2.0.tm
@@ -0,0 +1,5 @@
+namespace eval mod2::test2 {}
+
+proc mod2::test2::try2 args {
+ return res2
+}
diff --git a/tests/auto0/modules/test0-0.5.tm b/tests/auto0/modules/test0-0.5.tm
new file mode 100644
index 0000000..19f3613
--- /dev/null
+++ b/tests/auto0/modules/test0-0.5.tm
@@ -0,0 +1,5 @@
+namespace eval test0 {}
+
+proc test0::try0 args {
+ return res0
+}
diff --git a/tests/safe.test b/tests/safe.test
index 11ad2a9..71fe0fb 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -24,6 +24,8 @@ foreach i [interp slaves] {
set saveAutoPath $::auto_path
set ::auto_path [info library]
+set TestsDir [file normalize [file dirname [info script]]]
+
# 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}
@@ -179,6 +181,126 @@ test safe-6.3 {test safe interpreters knowledge of the world} {
# More test should be added to check that hostname, nameofexecutable, aren't
# leaking infos, but they still do...
+# Tests 7.0* test the example files before using them to test safe interpreters.
+
+test safe-7.0a {example tclIndex commands, test in master interpreter} -setup {
+ set tmpAutoPath $::auto_path
+ lappend ::auto_path [file join $TestsDir auto0 auto1] [file join $TestsDir auto0 auto2]
+} -body {
+ # Try to load the commands.
+ set code3 [catch report1 msg3]
+ set code4 [catch report2 msg4]
+ list $code3 $msg3 $code4 $msg4
+} -cleanup {
+ catch {rename report1 {}}
+ catch {rename report2 {}}
+ set ::auto_path $tmpAutoPath
+ auto_reset
+} -match glob -result {0 ok1 0 ok2}
+
+test safe-7.0b {example tclIndex commands, negative test in master interpreter} -setup {
+ set tmpAutoPath $::auto_path
+ lappend ::auto_path [file join $TestsDir auto0]
+} -body {
+ # Try to load the commands.
+ set code3 [catch report1 msg3]
+ set code4 [catch report2 msg4]
+ list $code3 $msg3 $code4 $msg4
+} -cleanup {
+ catch {rename report1 {}}
+ catch {rename report2 {}}
+ set ::auto_path $tmpAutoPath
+ auto_reset
+} -match glob -result {1 {invalid command name "report1"} 1 {invalid command name "report2"}}
+
+test safe-7.0c {example pkgIndex.tcl packages, test in master interpreter, child directories} -setup {
+ set tmpAutoPath $::auto_path
+ lappend ::auto_path [file join $TestsDir auto0]
+} -body {
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {package require SafeTestPackage1} msg3]
+ set code4 [catch {package require SafeTestPackage2} msg4]
+ set code5 [catch HeresPackage1 msg5]
+ set code6 [catch HeresPackage2 msg6]
+
+ list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
+} -cleanup {
+ set ::auto_path $tmpAutoPath
+ catch {package forget SafeTestPackage1}
+ catch {package forget SafeTestPackage2}
+ catch {rename HeresPackage1 {}}
+ catch {rename HeresPackage2 {}}
+} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
+
+test safe-7.0d {example pkgIndex.tcl packages, test in master interpreter, main directories} -setup {
+ set tmpAutoPath $::auto_path
+ lappend ::auto_path [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]
+} -body {
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {package require SafeTestPackage1} msg3]
+ set code4 [catch {package require SafeTestPackage2} msg4]
+ set code5 [catch HeresPackage1 msg5]
+ set code6 [catch HeresPackage2 msg6]
+
+ list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
+} -cleanup {
+ set ::auto_path $tmpAutoPath
+ catch {package forget SafeTestPackage1}
+ catch {package forget SafeTestPackage2}
+ catch {rename HeresPackage1 {}}
+ catch {rename HeresPackage2 {}}
+} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
+
+test safe-7.0e {example modules packages, test in master interpreter, replace path} -setup {
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+} -body {
+ # Try to load the modules and run a command from each one.
+ set code0 [catch {package require test0} msg0]
+ set code1 [catch {package require mod1::test1} msg1]
+ set code2 [catch {package require mod2::test2} msg2]
+ set out0 [test0::try0]
+ set out1 [mod1::test1::try1]
+ set out2 [mod2::test2::try2]
+
+ list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ catch {package forget test0}
+ catch {package forget mod1::test1}
+ catch {package forget mod2::test2}
+ catch {namespace delete ::test0}
+ catch {namespace delete ::mod1}
+} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}
+
+test safe-7.0f {example modules packages, test in master interpreter, append to path} -setup {
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+} -body {
+ # Try to load the modules and run a command from each one.
+ set code0 [catch {package require test0} msg0]
+ set code1 [catch {package require mod1::test1} msg1]
+ set code2 [catch {package require mod2::test2} msg2]
+ set out0 [test0::try0]
+ set out1 [mod1::test1::try1]
+ set out2 [mod2::test2::try2]
+
+ list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ catch {package forget test0}
+ catch {package forget mod1::test1}
+ catch {package forget mod2::test2}
+ catch {namespace delete ::test0}
+ catch {namespace delete ::mod1}
+} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}
+
# high level general test
test safe-7.1 {tests that everything works at high level} -body {
set i [safe::interpCreate]
@@ -833,6 +955,7 @@ test safe-16.4 {Bug 3529949: defang ~user in globs} -setup {
} -result {}
set ::auto_path $saveAutoPath
+unset saveAutoPath TestsDir
# cleanup
::tcltest::cleanupTests
return