diff options
Diffstat (limited to 'tests/clone.test')
| -rw-r--r-- | tests/clone.test | 158 |
1 files changed, 158 insertions, 0 deletions
diff --git a/tests/clone.test b/tests/clone.test new file mode 100644 index 0000000..223acbb --- /dev/null +++ b/tests/clone.test @@ -0,0 +1,158 @@ +# -*- tcl -*- Commands covered: interpreter cloning ... +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1991-1993 The Regents of the University of California. +# Copyright (c) 1994-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 2002 by ActiveState Corporation. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# RCS: @(#) $Id: clone.test,v 1.1.2.1 2002/11/26 19:49:00 andreas_kupries Exp $ + +# Prevent execution of these tests when running in the cloned interpreter !! +if {[info exists __clone__]} return + +memory validate on + + +if {[lsearch [namespace children] ::tcltest] == -1} { + package require tcltest + namespace import -force ::tcltest::* +} + + +proc foo {} { + # Have a compiled local variable. + set dummy 22 +} + + +test clone-1.1 {simple creation and destruction} { + # This test checks that the basic creation of a clone, and its + # destruction do not crash. The continued execution of the regular + # testsuite in the main interpreter immediately after this test + # also checks that the desctruction of hte clone did not disrupt + # the original. + + testclone create + testclone destroy + set a 0 +} {0} + +test clone-1.2 {linked variables} { + # Check that variables linked between namespaces are cloned + # correctly (need fixup similar to commands imported into + # namespaces), and that their values are ok. This essentially + # tests sharing of contents, and the inter-var references. + + set a "" + namespace eval ::__foo__ {variable xx 1} + namespace eval ::__bar__ {upvar ::__foo__::xx xx} + + append a m[set ::__foo__::xx][set ::__bar__::xx] + + testclone create + append a -c[testclone eval {set ::__foo__::xx}][testclone eval {set ::__bar__::xx}] + append a m[set ::__foo__::xx][set ::__bar__::xx] + + testclone destroy + append a -m[set ::__foo__::xx][set ::__bar__::xx] + + namespace delete ::__foo__ + namespace delete ::__bar__ + set a +} {m11-c11m11-m11} + +test clone-1.3 {cloned variables} { + # Check that variables linked between namespaces are cloned + # correctly (need fixup similar to commands imported into + # namespaces). Tests sharing of contents. + + set a "" + append a "m[set tcl_patchLevel]" + + testclone create + append a -c[testclone eval {set tcl_patchLevel}] + append a m[set tcl_patchLevel] + + testclone destroy + append a -m[set tcl_patchLevel] + + set a +} {m8.3.4-c8.3.4m8.3.4-m8.3.4} + +test clone-1.4 {cloned variables, arrays} { + # Check that variables linked between namespaces are cloned + # correctly (need fixup similar to commands imported into + # namespaces). Tests that sharing of arrays is ok. + + array set x {x _} + + set a "" + append a "m[array get x]" + + testclone create + append a -c[testclone eval {array get x}] + append a m[array get x] + + testclone destroy + append a -m[array get x] + + set a +} {mx _-cx _mx _-mx _} + + +proc act_Setup { } { + global dest + global beep + + set beep 11 +} + +test clone-1.5 {eval proc} { + # This test checks that the basic creation of a clone, and its + # destruction do not crash. The continued execution of the regular + # testsuite in the main interpreter immediately after this test + # also checks that the desctruction of hte clone did not disrupt + # the original. + + testclone create + set res [testclone eval {act_Setup}] + testclone destroy + set res +} {11} + + + +test clone-2.0 {sub testsuite} { + # Now we run the entire testsuite in the cloned interpreter. + # This should stress test the data structures, especially + # the execution of shared bytecode. + + puts ___ + puts "___ Running the entire testsuite inside of the cloned interpreter" + puts ___ + puts ___ + + testclone create + testclone eval {set __clone__ 1} + set res [testclone eval [list source [file join $tcltest::testsDirectory all.tcl]]] + testclone destroy + set res +} {} + +#exit + +puts ___ +puts "___ Proceeding to run the entire testsuite in the main interpreter." +puts ___ +puts ___ + +# cleanup +::tcltest::cleanupTests +return |