Subversion Repositories or1k

#

# Tests for code/scope commands

# ----------------------------------------------------------------------

#   AUTHOR:  Michael J. McLennan

#            Bell Labs Innovations for Lucent Technologies

#            mmclennan@lucent.com

#            http://www.tcltk.com/itcl

#

#      RCS:  $Id: scope.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.

if {[string compare test [info procs test]] == 1} then {source defs}

# ----------------------------------------------------------------------

#  Syntax of the "scope" command

# ----------------------------------------------------------------------

test scope-1.1 {scope command takes one argument} {

    list [catch {itcl::scope} msg] $msg [catch {itcl::scope x y} msg] $msg

} {1 {wrong # args: should be "itcl::scope varname"} 1 {wrong # args: should be "itcl::scope varname"}}

test scope-1.2 {argument to scope command must be a variable} {

    variable test_scope_var 0

    list [catch {itcl::scope xyzzy} msg] $msg \

         [catch {itcl::scope test_scope_var} msg] $msg

} {1 {variable "xyzzy" not found in namespace "::"} 0 ::test_scope_var}

test scope-1.3 {if variable is already fully qualified, scope does nothing} {

    list [itcl::scope ::xyzzy] [itcl::scope ::test_scope_var]

} {::xyzzy ::test_scope_var}

test scope-1.4 {scope command returns fully qualified name} {

    namespace eval test_scope_ns {

        namespace eval child {

            variable v1 0

            itcl::scope v1

        }

    }

} {::test_scope_ns::child::v1}

namespace delete test_scope_ns

unset test_scope_var

# ----------------------------------------------------------------------

#  Syntax of the "code" command

# ----------------------------------------------------------------------

test scope-2.1 {code command takes at least one argument} {

    list [catch {itcl::code} msg] $msg

} {1 {wrong # args: should be "itcl::code ?-namespace name? command ?arg arg...?"}}

test scope-2.2 {code command with one argument} {

    itcl::code arg1

} {namespace inscope :: arg1}

test scope-2.3 {code command with many arguments} {

    list [itcl::code arg1 arg2] [itcl::code arg1 arg2 arg3 arg4]

} {{namespace inscope :: {arg1 arg2}} {namespace inscope :: {arg1 arg2 arg3 arg4}}}

test scope-2.4 {code command appends arguments as list elements} {

    list [itcl::code "foo bar"] \

         [itcl::code "foo bar" "hello, world!" "one, two, three"]

} {{namespace inscope :: {foo bar}} {namespace inscope :: {{foo bar} {hello, world!} {one, two, three}}}}

test scope-2.5 {code command inside code command} {

    itcl::code [itcl::code arg1 arg2] arg3

} {namespace inscope :: {{namespace inscope :: {arg1 arg2}} arg3}}

test scope-2.6 {code command returns fully qualified names} {

    namespace eval test_scope_ns {

        namespace eval child {

            itcl::code foo bar baz

        }

    }

} {namespace inscope ::test_scope_ns::child {foo bar baz}}

test scope-2.7 {code command lets you specify a namespace} {

    list [catch {itcl::code -namespace xyzzy arg1 arg2} msg] $msg \

         [catch {itcl::code -namespace test_scope_ns::child arg1 arg2} msg] $msg

} {1 {unknown namespace "xyzzy"} 0 {namespace inscope ::test_scope_ns::child {arg1 arg2}}}

test scope-2.8 {last namespace wins} {

    itcl::code -namespace test_scope_ns::child -namespace test_scope_ns arg1

} {namespace inscope ::test_scope_ns arg1}

test scope-2.9 {"--" terminates switches} {

    list [catch {itcl::code -namespace test_scope_ns -foo -bar} msg] $msg \

         [catch {itcl::code -namespace test_scope_ns -- -foo -bar} msg] $msg

} {1 {bad option "-foo": should be -namespace or --} 0 {namespace inscope ::test_scope_ns {-foo -bar}}}

namespace delete test_scope_ns

# ----------------------------------------------------------------------

#  Test code/scope commands in a class

# ----------------------------------------------------------------------

test scope-3.1 {define simple classes with things to export} {

    itcl::class test_scope {

        private variable priv "private-value"

        protected variable prov "protected-value"

        public variable pubv "public-value"

        private common pric "private-common-value"

        protected common proc "protected-common-value"

        public common pubc "public-common-value"

        variable varray

        common carray

        method mcontext {args} {

            return [eval $args]

        }

        proc pcontext {args} {

            return [eval $args]

        }

        private method prim {args} {

            return "prim: $args"

        }

        protected method prom {args} {

            return "prom: $args"

        }

        public method pubm {args} {

            return "pubm: $args"

        }

    }

    test_scope #auto

} {test_scope0}

test scope-3.2 {code command captures only class context} {

    list [test_scope0 mcontext itcl::code arg1 arg2] \

         [test_scope::pcontext itcl::code arg1 arg2]

} {{namespace inscope ::test_scope {arg1 arg2}} {namespace inscope ::test_scope {arg1 arg2}}}

test scope-3.3 {scope command captures class and object context} {

    list [test_scope0 mcontext itcl::scope priv] \

         [test_scope::pcontext itcl::scope pric]

} {{@itcl ::test_scope0 ::test_scope::priv} ::test_scope::pric}

test scope-3.4 {scope command must recognize variable} {

    list [catch {test_scope0 mcontext itcl::scope xyzzy} msg] $msg

} {1 {variable "xyzzy" not found in class "::test_scope"}}

test scope-3.5 {scope command provides access to instance variables} {

    set result ""

    foreach vname {priv prov pubv} {

        lappend result [test_scope0 info variable $vname]

        set var [test_scope0 mcontext itcl::scope $vname]

        set $var "$vname-new"

        lappend result [test_scope0 info variable $vname]

    }

    set result

} {{private variable ::test_scope::priv private-value private-value} {private variable ::test_scope::priv private-value priv-new} {protected variable ::test_scope::prov protected-value protected-value} {protected variable ::test_scope::prov protected-value prov-new} {public variable ::test_scope::pubv public-value {} public-value} {public variable ::test_scope::pubv public-value {} pubv-new}}

test scope-3.6 {scope command provides access to common variables} {

    set result ""

    foreach vname {pric proc pubc} {

        lappend result [test_scope0 info variable $vname]

        set var [test_scope0 mcontext itcl::scope $vname]

        set $var "$vname-new"

        lappend result [test_scope0 info variable $vname]

    }

    set result

} {{private common ::test_scope::pric private-common-value private-common-value} {private common ::test_scope::pric private-common-value pric-new} {protected common ::test_scope::proc protected-common-value protected-common-value} {protected common ::test_scope::proc protected-common-value proc-new} {public common ::test_scope::pubc public-common-value public-common-value} {public common ::test_scope::pubc public-common-value pubc-new}}

test scope-3.7 {code command provides access to methods} {

    set result ""

    foreach mname {prim prom pubm} {

        set cmd [test_scope0 mcontext eval itcl::code \$this $mname]

        lappend result $cmd [$cmd 1 2 3]

    }

    set result

} {{namespace inscope ::test_scope {::test_scope0 prim}} {prim: 1 2 3} {namespace inscope ::test_scope {::test_scope0 prom}} {prom: 1 2 3} {namespace inscope ::test_scope {::test_scope0 pubm}} {pubm: 1 2 3}}

test scope-3.8 {scope command allows access to slots in an array} {

    test_scope0 mcontext set varray(0) "defined"

    test_scope::pcontext set carray(0) "defined"

    list [catch {test_scope0 mcontext scope varray(0)} msg] $msg \

         [catch {test_scope0 mcontext scope varray(1)} msg] $msg \

         [catch {test_scope::pcontext scope carray(0)} msg] $msg \

         [catch {test_scope::pcontext scope carray(1)} msg] $msg

} {0 {@itcl ::test_scope0 ::test_scope::varray(0)} 0 {@itcl ::test_scope0 ::test_scope::varray(1)} 0 ::test_scope::carray(0) 0 ::test_scope::carray(1)}

itcl::delete class test_scope

# ----------------------------------------------------------------------

#  Test code/scope commands in a namespace

# ----------------------------------------------------------------------

test scope-4.1 {define simple namespace with things to export} {

    namespace eval test_scope_ns {

        variable array

        proc pcontext {args} {

            return [eval $args]

        }

    }

    namespace children :: ::test_scope_ns

} {::test_scope_ns}

test scope-4.2 {scope command allows access to slots in an array} {

    test_scope_ns::pcontext set array(0) "defined"

    list [catch {test_scope_ns::pcontext scope array(0)} msg] $msg \

         [catch {test_scope_ns::pcontext scope array(1)} msg] $msg

} {0 ::test_scope_ns::array(0) 0 ::test_scope_ns::array(1)}

namespace delete test_scope_ns