1#
2# Tests for code/scope commands
3# ----------------------------------------------------------------------
4#   AUTHOR:  Michael J. McLennan
5#            Bell Labs Innovations for Lucent Technologies
6#            mmclennan@lucent.com
7#            http://www.tcltk.com/itcl
8#
9#      RCS:  $Id: scope.test,v 1.4 2004/02/12 18:09:50 davygrvy Exp $
10# ----------------------------------------------------------------------
11#            Copyright (c) 1993-1998  Lucent Technologies, Inc.
12# ======================================================================
13# See the file "license.terms" for information on usage and
14# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15
16if {[lsearch [namespace children] ::tcltest] == -1} {
17    package require tcltest 2.1
18    namespace import -force ::tcltest::test
19}
20
21::tcltest::loadTestedCommands
22
23# ----------------------------------------------------------------------
24#  Syntax of the "scope" command
25# ----------------------------------------------------------------------
26test scope-1.1 {scope command takes one argument} {
27    list [catch {itcl::scope} msg] $msg [catch {itcl::scope x y} msg] $msg
28} {1 {wrong # args: should be "itcl::scope varname"} 1 {wrong # args: should be "itcl::scope varname"}}
29
30test scope-1.2 {argument to scope command must be a variable} {
31    variable test_scope_var 0
32    list [catch {itcl::scope xyzzy} msg] $msg \
33         [catch {itcl::scope test_scope_var} msg] $msg
34} {1 {variable "xyzzy" not found in namespace "::"} 0 ::test_scope_var}
35
36test scope-1.3 {if variable is already fully qualified, scope does nothing} {
37    list [itcl::scope ::xyzzy] [itcl::scope ::test_scope_var]
38} {::xyzzy ::test_scope_var}
39
40test scope-1.4 {scope command returns fully qualified name} {
41    namespace eval test_scope_ns {
42        namespace eval child {
43            variable v1 0
44            itcl::scope v1
45        }
46    }
47} {::test_scope_ns::child::v1}
48
49namespace delete test_scope_ns
50unset test_scope_var
51
52# ----------------------------------------------------------------------
53#  Syntax of the "code" command
54# ----------------------------------------------------------------------
55test scope-2.1 {code command takes at least one argument} {
56    list [catch {itcl::code} msg] $msg
57} {1 {wrong # args: should be "itcl::code ?-namespace name? command ?arg arg...?"}}
58
59test scope-2.2 {code command with one argument} {
60    itcl::code arg1
61} {namespace inscope :: arg1}
62
63test scope-2.3 {code command with many arguments} {
64    list [itcl::code arg1 arg2] [itcl::code arg1 arg2 arg3 arg4]
65} {{namespace inscope :: {arg1 arg2}} {namespace inscope :: {arg1 arg2 arg3 arg4}}}
66
67test scope-2.4 {code command appends arguments as list elements} {
68    list [itcl::code "foo bar"] \
69         [itcl::code "foo bar" "hello, world!" "one, two, three"]
70} {{namespace inscope :: {foo bar}} {namespace inscope :: {{foo bar} {hello, world!} {one, two, three}}}}
71
72test scope-2.5 {code command inside code command} {
73    itcl::code [itcl::code arg1 arg2] arg3
74} {namespace inscope :: {{namespace inscope :: {arg1 arg2}} arg3}}
75
76test scope-2.6 {code command returns fully qualified names} {
77    namespace eval test_scope_ns {
78        namespace eval child {
79            itcl::code foo bar baz
80        }
81    }
82} {namespace inscope ::test_scope_ns::child {foo bar baz}}
83
84test scope-2.7 {code command lets you specify a namespace} {
85    list [catch {itcl::code -namespace xyzzy arg1 arg2} msg] $msg \
86         [catch {itcl::code -namespace test_scope_ns::child arg1 arg2} msg] $msg
87} {1 {unknown namespace "xyzzy"} 0 {namespace inscope ::test_scope_ns::child {arg1 arg2}}}
88
89test scope-2.8 {last namespace wins} {
90    itcl::code -namespace test_scope_ns::child -namespace test_scope_ns arg1
91} {namespace inscope ::test_scope_ns arg1}
92
93test scope-2.9 {"--" terminates switches} {
94    list [catch {itcl::code -namespace test_scope_ns -foo -bar} msg] $msg \
95         [catch {itcl::code -namespace test_scope_ns -- -foo -bar} msg] $msg
96    
97} {1 {bad option "-foo": should be -namespace or --} 0 {namespace inscope ::test_scope_ns {-foo -bar}}}
98
99namespace delete test_scope_ns
100
101# ----------------------------------------------------------------------
102#  Test code/scope commands in a class
103# ----------------------------------------------------------------------
104test scope-3.1 {define simple classes with things to export} {
105    itcl::class test_scope {
106        private variable priv "private-value"
107        protected variable prov "protected-value"
108        public variable pubv "public-value"
109
110        private common pric "private-common-value"
111        protected common proc "protected-common-value"
112        public common pubc "public-common-value"
113
114        variable varray
115        common carray
116
117        method mcontext {args} {
118            return [eval $args]
119        }
120        proc pcontext {args} {
121            return [eval $args]
122        }
123
124        private method prim {args} {
125            return "prim: $args"
126        }
127        protected method prom {args} {
128            return "prom: $args"
129        }
130        public method pubm {args} {
131            return "pubm: $args"
132        }
133    }
134    test_scope #auto
135} {test_scope0}
136
137test scope-3.2 {code command captures only class context} {
138    list [test_scope0 mcontext itcl::code arg1 arg2] \
139         [test_scope::pcontext itcl::code arg1 arg2]
140} {{namespace inscope ::test_scope {arg1 arg2}} {namespace inscope ::test_scope {arg1 arg2}}}
141
142test scope-3.3 {scope command captures class and object context} {
143    list [test_scope0 mcontext itcl::scope priv] \
144         [test_scope::pcontext itcl::scope pric]
145} {{@itcl ::test_scope0 ::test_scope::priv} ::test_scope::pric}
146
147test scope-3.4 {scope command must recognize variable} {
148    list [catch {test_scope0 mcontext itcl::scope xyzzy} msg] $msg
149} {1 {variable "xyzzy" not found in class "::test_scope"}}
150
151test scope-3.5 {scope command provides access to instance variables} {
152    set result ""
153    foreach vname {priv prov pubv} {
154        lappend result [test_scope0 info variable $vname]
155        set var [test_scope0 mcontext itcl::scope $vname]
156        set $var "$vname-new"
157        lappend result [test_scope0 info variable $vname]
158    }
159    set result
160} {{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}}
161
162test scope-3.6 {scope command provides access to common variables} {
163    set result ""
164    foreach vname {pric proc pubc} {
165        lappend result [test_scope0 info variable $vname]
166        set var [test_scope0 mcontext itcl::scope $vname]
167        set $var "$vname-new"
168        lappend result [test_scope0 info variable $vname]
169    }
170    set result
171} {{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}}
172
173test scope-3.7 {code command provides access to methods} {
174    set result ""
175    foreach mname {prim prom pubm} {
176        set cmd [test_scope0 mcontext eval itcl::code \$this $mname]
177        lappend result $cmd [$cmd 1 2 3]
178    }
179    set result
180} {{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}}
181
182test scope-3.8 {scope command allows access to slots in an array} {
183    test_scope0 mcontext set varray(0) "defined"
184    test_scope::pcontext set carray(0) "defined"
185    list [catch {test_scope0 mcontext itcl::scope varray(0)} msg] $msg \
186         [catch {test_scope0 mcontext itcl::scope varray(1)} msg] $msg \
187         [catch {test_scope::pcontext itcl::scope carray(0)} msg] $msg \
188         [catch {test_scope::pcontext itcl::scope carray(1)} msg] $msg
189} {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)}
190
191itcl::delete class test_scope
192
193# ----------------------------------------------------------------------
194#  Test code/scope commands in a namespace
195# ----------------------------------------------------------------------
196test scope-4.1 {define simple namespace with things to export} {
197    namespace eval test_scope_ns {
198        variable array
199        proc pcontext {args} {
200            return [eval $args]
201        }
202    }
203    namespace children :: ::test_scope_ns
204} {::test_scope_ns}
205
206test scope-4.2 {scope command allows access to slots in an array} {
207    test_scope_ns::pcontext set array(0) "defined"
208    list [catch {test_scope_ns::pcontext itcl::scope array(0)} msg] $msg \
209         [catch {test_scope_ns::pcontext itcl::scope array(1)} msg] $msg
210} {0 ::test_scope_ns::array(0) 0 ::test_scope_ns::array(1)}
211
212namespace delete test_scope_ns
213
214::tcltest::cleanupTests
215return
216