#
# Tests for "upvar" across interpreter boundaries
# ----------------------------------------------------------------------
#   AUTHOR:  Michael J. McLennan       Phone: (610)712-2842
#            AT&T Bell Laboratories   E-mail: michael.mclennan@att.com
#
#      RCS:  upvar.test,v 1.1.1.1 1994/03/21 22:09:52 mmc Exp
# ----------------------------------------------------------------------
#               Copyright (c) 1993  AT&T Bell Laboratories
# ======================================================================
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that the copyright notice and warranty disclaimer appear in
# supporting documentation, and that the names of AT&T Bell Laboratories
# any of their entities not be used in advertising or publicity
# pertaining to distribution of the software without specific, written
# prior permission.
#
# AT&T disclaims all warranties with regard to this software, including
# all implied warranties of merchantability and fitness.  In no event
# shall AT&T be liable for any special, indirect or consequential
# damages or any damages whatsoever resulting from loss of use, data or
# profits, whether in an action of contract, negligence or other
# tortuous action, arising out of or in connection with the use or
# performance of this software.
# ======================================================================

# ----------------------------------------------------------------------
#  DEFINE SOME USEFUL ROUTINES
# ----------------------------------------------------------------------
proc upvarTest_show_var {var val} {
	return "$var>>$val"
}

proc upvarTest_upvar_in_procs {} {
	set upvarTest_var_local "value in main interp"
	foo do {
		upvar upvarTest_var_local var
		set var
	}
}

# ----------------------------------------------------------------------
#  CREATE SOME OBJECTS
# ----------------------------------------------------------------------
Foo foo
Baz baz

# ----------------------------------------------------------------------
#  UPVAR TESTS
# ----------------------------------------------------------------------
test {"::" sends command to global interp but preserves
local variables.  This ensures that when control
shifts to the global scope for Extended Tcl commands,
Expect commands, etc., local variables will be
recognized.} {
	foo do {
		set localvar "special"
		::eval {upvarTest_show_var localvar $localvar}
	}
} {
	$result == "Foo says 'localvar>>special'"
}


test {"upvar" can cross interp boundaries to access local variables} {
	upvarTest_upvar_in_procs
} {
	$result == "Foo says 'value in main interp'"
}

test {"upvar" can cross interp boundaries to access global variables} {
	set upvarTest_var_global "value in main interp"
	foo do {
		upvar upvarTest_var_global var
		set var
	}
} {
	$result == "Foo says 'value in main interp'"
}

test {"upvar" can handle multiple call frames on the stack} {
	set upvarTest_var_global "new value"
	foo do {
		foo do {
			upvar #0 upvarTest_var_global var
			set var
		}
	}
} {
	$result == "Foo says 'Foo says 'new value''"
}

test {"upvar" can cross class interp boundaries} {
	baz do {
		set localvar "value in Baz"
		foo do {
			upvar localvar var
			set var
		}
	}
} {
	$result == "Baz says 'Foo says 'value in Baz''"
}

test {"upvar" can cross class interp boundaries back to main interp} {
	set upvarTest_var_global "global value"
	baz do {
		foo do {
			upvar 2 upvarTest_var_global var
			set var
		}
	}
} {
	$result == "Baz says 'Foo says 'global value''"
}

# ----------------------------------------------------------------------
#  CLEAN UP
# ----------------------------------------------------------------------
foo delete
baz delete