summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2011-10-15 16:48:16 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2011-10-15 16:48:16 (GMT)
commitc340a3859f1dfc7b1e77c4d0db35a94d3463f60d (patch)
tree797c8a1537350ab47482fc746ba2c733019f3d67 /tests
parent971594ecc4d41c4f217aa38a911f6858e81ca5d0 (diff)
downloadtcl-c340a3859f1dfc7b1e77c4d0db35a94d3463f60d.zip
tcl-c340a3859f1dfc7b1e77c4d0db35a94d3463f60d.tar.gz
tcl-c340a3859f1dfc7b1e77c4d0db35a94d3463f60d.tar.bz2
And the failing test file too...
Diffstat (limited to 'tests')
-rw-r--r--tests/resolver.test200
1 files changed, 200 insertions, 0 deletions
diff --git a/tests/resolver.test b/tests/resolver.test
new file mode 100644
index 0000000..bb9f59d
--- /dev/null
+++ b/tests/resolver.test
@@ -0,0 +1,200 @@
+# This test collection covers some unwanted interactions between command
+# literal sharing and the use of command resolvers (per-interp) which cause
+# command literals to be re-used with their command references being invalid
+# in the reusing context. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 2011 Gustaf Neumann <gustaf.neumann@wu.ac.at>
+# Copyright (c) 2011 Stefan Sobernig <stefan.sobernig@wu.ac.at>
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require tcltest 2
+if {"::tcltest" in [namespace children]} {
+ namespace import -force ::tcltest::*
+}
+
+testConstraint testinterpresolver [llength [info commands testinterpresolver]]
+
+test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup {
+ testinterpresolver up
+ namespace eval ::ns1 {
+ proc z {} { return Z }
+ namespace export z
+ }
+ proc ::y {} { return Y }
+ proc ::x {} {
+ z
+ }
+} -constraints testinterpresolver -body {
+ # 1) Have the proc body compiled: During compilation or, alternatively,
+ # the first evaluation of the compiled body, the InterpCmdResolver (see
+ # tclTest.c) maps the cmd token "z" to "::y"; this mapping is saved in the
+ # resulting CmdName Tcl_Obj with the print string "z". The CmdName Tcl_Obj
+ # is turned into a command literal shared for a given (here: the global)
+ # namespace.
+ set r0 [x]; # --> The result of [x] is "Y"
+ # 2) After having requested cmd resolution above, we can now use the
+ # globally shared CmdName Tcl_Obj "z", now bound to cmd ::y. This is
+ # certainly questionable, but defensible
+ set r1 [z]; # --> The result of [z] is "Y"
+ # 3) We import from the namespace ns1 another z. [namespace import] takes
+ # care "shadowed" cmd references, however, till now cmd literals have not
+ # been touched. This is, however, necessary since the BC compiler (used in
+ # the [namespace eval]) seems to be eager to reuse CmdName Tcl_Objs as cmd
+ # literals for a given NS scope. We expect, that r2 is "Z", the result of
+ # the namespace imported cmd.
+ namespace eval :: {
+ namespace import ::ns1::z
+ set r2 [z]
+ }
+ list $r0 $r1 $::r2
+} -cleanup {
+ testinterpresolver down
+ rename ::x ""
+ rename ::y ""
+ namespace delete ::ns1
+} -result {Y Y Z}
+test resolver-1.2 {cmdNameObj sharing vs. cmd resolver: proc creation} -setup {
+ testinterpresolver up
+ proc ::y {} { return Y }
+ proc ::x {} {
+ z
+ }
+} -constraints testinterpresolver -body {
+ set r0 [x]
+ set r1 [z]
+ proc ::foo {} {
+ proc ::z {} { return Z }
+ return [z]
+ }
+ list $r0 $r1 [::foo]
+} -cleanup {
+ testinterpresolver down
+ rename ::x ""
+ rename ::y ""
+ rename ::foo ""
+ rename ::z ""
+} -result {Y Y Z}
+test resolver-1.3 {cmdNameObj sharing vs. cmd resolver: rename} -setup {
+ testinterpresolver up
+ proc ::Z {} { return Z }
+ proc ::y {} { return Y }
+ proc ::x {} {
+ z
+ }
+} -constraints testinterpresolver -body {
+ set r0 [x]
+ set r1 [z]
+ namespace eval :: {
+ rename ::Z ::z
+ set r2 [z]
+ }
+ list $r0 $r1 $r2
+} -cleanup {
+ testinterpresolver down
+ rename ::x ""
+ rename ::y ""
+ rename ::z ""
+} -result {Y Y Z}
+test resolver-1.4 {cmdNameObj sharing vs. cmd resolver: interp expose} -setup {
+ testinterpresolver up
+ proc ::Z {} { return Z }
+ interp hide {} Z
+ proc ::y {} { return Y }
+ proc ::x {} {
+ z
+ }
+} -constraints testinterpresolver -body {
+ set r0 [x]
+ set r1 [z]
+ interp expose {} Z z
+ namespace eval :: {
+ set r2 [z]
+ }
+ list $r0 $r1 $r2
+} -cleanup {
+ testinterpresolver down
+ rename ::x ""
+ rename ::y ""
+ rename ::z ""
+} -result {Y Y Z}
+test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -setup {
+ testinterpresolver up
+ namespace eval ::ns1 {
+ proc z {} { return Z }
+ namespace export z
+ }
+ proc ::y {} { return Y }
+ namespace eval ::ns2 {
+ proc x {} {
+ z
+ }
+ }
+} -constraints testinterpresolver -body {
+ set r0 [namespace eval ::ns2 {x}]
+ set r1 [namespace eval ::ns2 {z}]
+ namespace eval ::ns2 {
+ namespace import ::ns1::z
+ set r2 [z]
+ }
+ list $r0 $r1 $r2
+} -cleanup {
+ testinterpresolver down
+ namespace delete ::ns2
+ namespace delete ::ns1
+} -result {Y Y Z}
+test resolver-1.6 {cmdNameObj sharing vs. cmd resolver: interp alias} -setup {
+ testinterpresolver up
+ proc ::Z {} { return Z }
+ proc ::y {} { return Y }
+ proc ::x {} {
+ z
+ }
+} -constraints testinterpresolver -body {
+ set r0 [x]
+ set r1 [z]
+ namespace eval :: {
+ interp alias {} ::z {} ::Z
+ set r2 [z]
+ }
+ list $r0 $r1 $r2
+} -cleanup {
+ testinterpresolver down
+ rename ::x ""
+ rename ::y ""
+ rename ::Z ""
+} -result {Y Y Z}
+
+test resolver-2.1 {compiled var resolver: Bug #3383616} -setup {
+ testinterpresolver up
+ # The compiled var resolver fetches just variables starting with a capital
+ # "T" and stores some test information in the resolver-specific resolver
+ # var info.
+ proc ::x {} {
+ set T1 100
+ return $T1
+ }
+} -constraints testinterpresolver -body {
+ # Call "x" the first time, causing a byte code compilation of the body.
+ # During the compilation the compiled var resolver, the resolve-specific
+ # var info is allocated, during the execution of the body, the variable is
+ # fetched and cached.
+ x;
+ # During later calls, the cached variable is reused.
+ x
+ # When the proc is freed, the resolver-specific resolver var info is
+ # freed. This did not happen before fix #3383616.
+ rename ::x ""
+} -cleanup {
+ testinterpresolver down
+} -result {}
+
+cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End: