Subversion Repositories or1k

#
# 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: uplevel.test,v 1.1.1.1 2002-01-16 10:24:47 markom Exp $
# ----------------------------------------------------------------------
#            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