1 files changed, 155 insertions, 0 deletions
diff --git a/itcl/itcl/tests/old/uplevel.test b/itcl/itcl/tests/old/uplevel.test
new file mode 100644
index 00000000000..527cb2cf200
--- /dev/null
+++ b/itcl/itcl/tests/old/uplevel.test
@@ -0,0 +1,155 @@
+#
+# Tests for "uplevel" across interpreter boundaries
+# ----------------------------------------------------------------------
+#   AUTHOR:  Michael J. McLennan
+#            Bell Labs Innovations for Lucent Technologies
+#            mmclennan@lucent.com
+#            http://www.tcltk.com/itcl
+#
+#      RCS:  $Id$
+# ----------------------------------------------------------------------
+#            Copyright (c) 1993-1998  Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ----------------------------------------------------------------------
+#  DEFINE SOME USEFUL ROUTINES
+# ----------------------------------------------------------------------
+proc uplevelTest_show_var {level var} {
+	return "$var>>[uplevel $level set $var]"
+}
+
+proc uplevelTest_do {cmd} {
+	eval $cmd
+}
+
+# ----------------------------------------------------------------------
+#  CREATE SOME OBJECTS
+# ----------------------------------------------------------------------
+Foo foo
+Baz baz
+
+# ----------------------------------------------------------------------
+#  UPLEVEL TESTS (main interp)
+# ----------------------------------------------------------------------
+test {"uplevel" can access global variables (via relative level)} {
+	set globalvar "global value"
+	uplevelTest_show_var 1 globalvar
+} {
+	$result == "globalvar>>global value"
+}
+
+test {"uplevel" can access global variables (via "#0")} {
+	set globalvar "global value"
+	uplevelTest_show_var #0 globalvar
+} {
+	$result == "globalvar>>global value"
+}
+
+test {"uplevel" can access local variables (via relative level)} {
+	uplevelTest_do {
+		set localvar "local value"
+		uplevelTest_show_var 1 localvar
+	}
+} {
+	$result == "localvar>>local value"
+}
+
+test {"uplevel" can access local variables (via relative level)} {
+	uplevelTest_do {
+		set localvar "proper value"
+		uplevelTest_do {
+			set localvar "not this one"
+			uplevelTest_show_var 2 localvar
+		}
+	}
+} {
+	$result == "localvar>>proper value"
+}
+
+test {"uplevel" can access local variables (via explicit level)} {
+	uplevelTest_do {
+		set localvar "local value"
+		uplevelTest_show_var #1 localvar
+	}
+} {
+	$result == "localvar>>local value"
+}
+
+# ----------------------------------------------------------------------
+#  UPLEVEL TESTS (across class interps)
+# ----------------------------------------------------------------------
+test {"uplevel" can cross class interps to access global variables} {
+	set globalvar "global value"
+	foo do {
+		uplevel #0 uplevelTest_show_var 1 globalvar
+	}
+} {
+	$result == "Foo says 'globalvar>>global value'"
+}
+
+test {"uplevel" can cross several class interps to access global variables} {
+	set globalvar "global value"
+	baz do {
+		foo do {
+			uplevel 2 uplevelTest_show_var #0 globalvar
+		}
+	}
+} {
+	$result == "Baz says 'Foo says 'globalvar>>global value''"
+}
+
+test {"uplevel" finds proper scope for execution} {
+	baz do {
+		foo do {
+			uplevel do {{info class}}
+		}
+	}
+} {
+	$result == "Baz says 'Foo says 'Baz says '::Baz'''"
+}
+
+test {"uplevel" finds proper scope for execution,
+and works in conjunction with "unknown" to access
+commands at the global scope with local call frames} {
+	baz do {
+		set bazvar "value in Baz"
+		foo do {
+			uplevel ::info locals
+		}
+	}
+} {
+	$result == "Baz says 'Foo says 'bazvar cmds''"
+}
+
+# ----------------------------------------------------------------------
+#  LEVEL TESTS (across class scopes)
+# ----------------------------------------------------------------------
+test {"info level" works across scope boundaries} {
+	baz do {
+		foo do {
+			info level
+		}
+	}
+} {
+	$result == "Baz says 'Foo says '2''"
+}
+
+test {"info level" works across scope boundaries} {
+	baz do {
+		foo do {
+			info level 0
+		}
+	}
+} {
+	$result == "Baz says 'Foo says 'do {
+			info level 0
+		}''"
+}
+
+# ----------------------------------------------------------------------
+#  CLEAN UP
+# ----------------------------------------------------------------------
+foo delete
+baz delete