diff options
Diffstat (limited to 'tests/resolver.test')
| -rw-r--r-- | tests/resolver.test | 321 |
1 files changed, 321 insertions, 0 deletions
diff --git a/tests/resolver.test b/tests/resolver.test new file mode 100644 index 0000000..9bb4c08 --- /dev/null +++ b/tests/resolver.test @@ -0,0 +1,321 @@ +# 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::* +} + +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + +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 + } + } + namespace eval :: { + variable r2 "" + } +} -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 {} + + +# +# The test resolver-3.1* test bad interactions of resolvers on the "global" +# (per interp) literal pools. A resolver might resolve a cmd literal depending +# on a context differently, whereas the cmd literal sharing assumed that the +# namespace containing the literal solely determines the resolved cmd (and is +# resolver-agnostic). +# +# In order to make the test cases for the per-interpreter cmd literal pool +# reproducable and to minimize interactions between test cases, we use a slave +# interpreter per test-case. +# +# +# Testing resolver in namespace-based context "ctx1" +# +test resolver-3.1a { + interp command resolver, + resolve literal "z" in proc "x1" in context "ctx1" +} -setup { + + interp create i0 + testinterpresolver up i0 + i0 eval { + proc y {} { return yy } + namespace eval ::ns { + proc x1 {} { z } + } + } +} -constraints testinterpresolver -body { + + set r [i0 eval {namespace eval ::ctx1 { + ::ns::x1 + }}] + + return $r +} -cleanup { + testinterpresolver down i0 + interp delete i0 +} -result {yy} + +# +# Testing resolver in namespace-based context "ctx2" +# +test resolver-3.1b { + interp command resolver, + resolve literal "z" in proc "x2" in context "ctx2" +} -setup { + + interp create i0 + testinterpresolver up i0 + i0 eval { + proc Y {} { return YY } + namespace eval ::ns { + proc x2 {} { z } + } + } +} -constraints testinterpresolver -body { + + set r [i0 eval {namespace eval ::ctx2 { + ::ns::x2 + }}] + + return $r +} -cleanup { + testinterpresolver down i0 + interp delete i0 +} -result {YY} + +# +# Testing resolver in namespace-based context "ctx1" and "ctx2" in the same +# interpreter. +# + +test resolver-3.1c { + interp command resolver, + resolve literal "z" in proc "x1" in context "ctx1", + resolve literal "z" in proc "x2" in context "ctx2" + + Test, whether the shared cmd literal created by the first byte-code + compilation interacts with the second one. +} -setup { + + interp create i0 + testinterpresolver up i0 + + i0 eval { + proc y {} { return yy } + proc Y {} { return YY } + namespace eval ::ns { + proc x1 {} { z } + proc x2 {} { z } + } + } + +} -constraints testinterpresolver -body { + + set r1 [i0 eval {namespace eval ::ctx1 { + ::ns::x1 + }}] + + set r2 [i0 eval {namespace eval ::ctx2 { + ::ns::x2 + }}] + + set r3 [i0 eval {namespace eval ::ctx1 { + ::ns::x1 + }}] + + return [list $r1 $r2 $r3] +} -cleanup { + testinterpresolver down i0 + interp delete i0 +} -result {yy YY yy} + + +cleanupTests +return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: |