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