OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [upvar.test] - Blame information for rev 578

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# Commands covered:  upvar
2 
#
3 
# This file contains a collection of tests for one or more of the Tcl
4 
# built-in commands.  Sourcing this file into Tcl runs the tests and
5 
# generates output for errors.  No output means no errors were found.
6 
#
7 
# Copyright (c) 1991-1993 The Regents of the University of California.
8 
# Copyright (c) 1994 Sun Microsystems, Inc.
9 
#
10 
# See the file "license.terms" for information on usage and redistribution
11 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 
#
13 
# RCS: @(#) $Id: upvar.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
14 
 
15 
if {[string compare test [info procs test]] == 1} then {source defs}
16 
 
17 
test upvar-1.1 {reading variables with upvar} {
18 
    proc p1 {a b} {set c 22; set d 33; p2}
19 
    proc p2 {} {upvar a x1 b x2 c x3 d x4; set a abc; list $x1 $x2 $x3 $x4 $a}
20 
    p1 foo bar
21 
} {foo bar 22 33 abc}
22 
test upvar-1.2 {reading variables with upvar} {
23 
    proc p1 {a b} {set c 22; set d 33; p2}
24 
    proc p2 {} {p3}
25 
    proc p3 {} {upvar 2 a x1 b x2 c x3 d x4; set a abc; list $x1 $x2 $x3 $x4 $a}
26 
    p1 foo bar
27 
} {foo bar 22 33 abc}
28 
test upvar-1.3 {reading variables with upvar} {
29 
    proc p1 {a b} {set c 22; set d 33; p2}
30 
    proc p2 {} {p3}
31 
    proc p3 {} {
32 
        upvar #1 a x1 b x2 c x3 d x4
33 
        set a abc
34 
        list $x1 $x2 $x3 $x4 $a
35 
    }
36 
    p1 foo bar
37 
} {foo bar 22 33 abc}
38 
test upvar-1.4 {reading variables with upvar} {
39 
    set x1 44
40 
    set x2 55
41 
    proc p1 {} {p2}
42 
    proc p2 {} {
43 
        upvar 2 x1 x1 x2 a
44 
        upvar #0 x1 b
45 
        set c $b
46 
        incr b 3
47 
        list $x1 $a $b
48 
    }
49 
    p1
50 
} {47 55 47}
51 
test upvar-1.5 {reading array elements with upvar} {
52 
    proc p1 {} {set a(0) zeroth; set a(1) first; p2}
53 
    proc p2 {} {upvar a(0) x; set x}
54 
    p1
55 
} {zeroth}
56 
 
57 
test upvar-2.1 {writing variables with upvar} {
58 
    proc p1 {a b} {set c 22; set d 33; p2; list $a $b $c $d}
59 
    proc p2 {} {
60 
        upvar a x1 b x2 c x3 d x4
61 
        set x1 14
62 
        set x4 88
63 
    }
64 
    p1 foo bar
65 
} {14 bar 22 88}
66 
test upvar-2.2 {writing variables with upvar} {
67 
    set x1 44
68 
    set x2 55
69 
    proc p1 {x1 x2} {
70 
        upvar #0 x1 a
71 
        upvar x2 b
72 
        set a $x1
73 
        set b $x2
74 
    }
75 
    p1 newbits morebits
76 
    list $x1 $x2
77 
} {newbits morebits}
78 
test upvar-2.3 {writing variables with upvar} {
79 
    catch {unset x1}
80 
    catch {unset x2}
81 
    proc p1 {x1 x2} {
82 
        upvar #0 x1 a
83 
        upvar x2 b
84 
        set a $x1
85 
        set b $x2
86 
    }
87 
    p1 newbits morebits
88 
    list [catch {set x1} msg] $msg [catch {set x2} msg] $msg
89 
} {0 newbits 0 morebits}
90 
test upvar-2.4 {writing array elements with upvar} {
91 
    proc p1 {} {set a(0) zeroth; set a(1) first; list [p2] $a(0)}
92 
    proc p2 {} {upvar a(0) x; set x xyzzy}
93 
    p1
94 
} {xyzzy xyzzy}
95 
 
96 
test upvar-3.1 {unsetting variables with upvar} {
97 
    proc p1 {a b} {set c 22; set d 33; p2; lsort [info vars]}
98 
    proc p2 {} {
99 
        upvar 1 a x1 d x2
100 
        unset x1 x2
101 
    }
102 
    p1 foo bar
103 
} {b c}
104 
test upvar-3.2 {unsetting variables with upvar} {
105 
    proc p1 {a b} {set c 22; set d 33; p2; lsort [info vars]}
106 
    proc p2 {} {
107 
        upvar 1 a x1 d x2
108 
        unset x1 x2
109 
        set x2 28
110 
    }
111 
    p1 foo bar
112 
} {b c d}
113 
test upvar-3.3 {unsetting variables with upvar} {
114 
    set x1 44
115 
    set x2 55
116 
    proc p1 {} {p2}
117 
    proc p2 {} {
118 
        upvar 2 x1 a
119 
        upvar #0 x2 b
120 
        unset a b
121 
    }
122 
    p1
123 
    list [info exists x1] [info exists x2]
124 
} {0 0}
125 
test upvar-3.4 {unsetting variables with upvar} {
126 
    set x1 44
127 
    set x2 55
128 
    proc p1 {} {
129 
        upvar x1 a x2 b
130 
        unset a b
131 
        set b 118
132 
    }
133 
    p1
134 
    list [info exists x1] [catch {set x2} msg] $msg
135 
} {0 0 118}
136 
test upvar-3.5 {unsetting array elements with upvar} {
137 
    proc p1 {} {
138 
        set a(0) zeroth
139 
        set a(1) first
140 
        set a(2) second
141 
        p2
142 
        array names a
143 
    }
144 
    proc p2 {} {upvar a(0) x; unset x}
145 
    p1
146 
} {1 2}
147 
test upvar-3.6 {unsetting then resetting array elements with upvar} {
148 
    proc p1 {} {
149 
        set a(0) zeroth
150 
        set a(1) first
151 
        set a(2) second
152 
        p2
153 
        list [array names a] [catch {set a(0)} msg] $msg
154 
    }
155 
    proc p2 {} {upvar a(0) x; unset x; set x 12345}
156 
    p1
157 
} {{0 1 2} 0 12345}
158 
 
159 
test upvar-4.1 {nested upvars} {
160 
    set x1 88
161 
    proc p1 {a b} {set c 22; set d 33; p2}
162 
    proc p2 {} {global x1; upvar c x2; p3}
163 
    proc p3 {} {
164 
        upvar x1 a x2 b
165 
        list $a $b
166 
    }
167 
    p1 14 15
168 
} {88 22}
169 
test upvar-4.2 {nested upvars} {
170 
    set x1 88
171 
    proc p1 {a b} {set c 22; set d 33; p2; list $a $b $c $d}
172 
    proc p2 {} {global x1; upvar c x2; p3}
173 
    proc p3 {} {
174 
        upvar x1 a x2 b
175 
        set a foo
176 
        set b bar
177 
    }
178 
    list [p1 14 15] $x1
179 
} {{14 15 bar 33} foo}
180 
 
181 
proc tproc {args} {global x; set x [list $args [uplevel info vars]]}
182 
test upvar-5.1 {traces involving upvars} {
183 
    proc p1 {a b} {set c 22; set d 33; trace var c rw tproc; p2}
184 
    proc p2 {} {upvar c x1; set x1 22}
185 
    set x ---
186 
    p1 foo bar
187 
    set x
188 
} {{x1 {} w} x1}
189 
test upvar-5.2 {traces involving upvars} {
190 
    proc p1 {a b} {set c 22; set d 33; trace var c rw tproc; p2}
191 
    proc p2 {} {upvar c x1; set x1}
192 
    set x ---
193 
    p1 foo bar
194 
    set x
195 
} {{x1 {} r} x1}
196 
test upvar-5.3 {traces involving upvars} {
197 
    proc p1 {a b} {set c 22; set d 33; trace var c rwu tproc; p2}
198 
    proc p2 {} {upvar c x1; unset x1}
199 
    set x ---
200 
    p1 foo bar
201 
    set x
202 
} {{x1 {} u} x1}
203 
 
204 
test upvar-6.1 {retargeting an upvar} {
205 
    proc p1 {} {
206 
        set a(0) zeroth
207 
        set a(1) first
208 
        set a(2) second
209 
        p2
210 
    }
211 
    proc p2 {} {
212 
        upvar a x
213 
        set result {}
214 
        foreach i [array names x] {
215 
            upvar a($i) x
216 
            lappend result $x
217 
        }
218 
        lsort $result
219 
    }
220 
    p1
221 
} {first second zeroth}
222 
test upvar-6.2 {retargeting an upvar} {
223 
    set x 44
224 
    set y abcde
225 
    proc p1 {} {
226 
        global x
227 
        set result $x
228 
        upvar y x
229 
        lappend result $x
230 
    }
231 
    p1
232 
} {44 abcde}
233 
test upvar-6.3 {retargeting an upvar} {
234 
    set x 44
235 
    set y abcde
236 
    proc p1 {} {
237 
        upvar y x
238 
        lappend result $x
239 
        global x
240 
        lappend result $x
241 
    }
242 
    p1
243 
} {abcde 44}
244 
 
245 
test upvar-7.1 {upvar to same level} {
246 
    set x 44
247 
    set y 55
248 
    catch {unset uv}
249 
    upvar #0 x uv
250 
    set uv abc
251 
    upvar 0 y uv
252 
    set uv xyzzy
253 
    list $x $y
254 
} {abc xyzzy}
255 
test upvar-7.2 {upvar to same level} {
256 
    set x 1234
257 
    set y 4567
258 
    proc p1 {x y} {
259 
        upvar 0 x uv
260 
        set uv $y
261 
        return "$x $y"
262 
    }
263 
    p1 44 89
264 
} {89 89}
265 
test upvar-7.3 {upvar to same level} {
266 
    set x 1234
267 
    set y 4567
268 
    proc p1 {x y} {
269 
        upvar #1 x uv
270 
        set uv $y
271 
        return "$x $y"
272 
    }
273 
    p1 xyz abc
274 
} {abc abc}
275 
test upvar-7.4 {upvar to same level: tricky problems when deleting variable table} {
276 
    proc tt {} {upvar #1 toto loc;  return $loc}
277 
    list [catch tt msg] $msg
278 
} {1 {can't read "loc": no such variable}}
279 
test upvar-7.5 {potential memory leak when deleting variable table} {
280 
    proc leak {} {
281 
        array set foo {1 2 3 4}
282 
        upvar 0 foo(1) bar
283 
    }
284 
    leak
285 
} {}
286 
 
287 
test upvar-8.1 {errors in upvar command} {
288 
    list [catch upvar msg] $msg
289 
} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
290 
test upvar-8.2 {errors in upvar command} {
291 
    list [catch {upvar 1} msg] $msg
292 
} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
293 
test upvar-8.3 {errors in upvar command} {
294 
    proc p1 {} {upvar a b c}
295 
    list [catch p1 msg] $msg
296 
} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
297 
test upvar-8.4 {errors in upvar command} {
298 
    proc p1 {} {upvar 0 b b}
299 
    list [catch p1 msg] $msg
300 
} {1 {can't upvar from variable to itself}}
301 
test upvar-8.5 {errors in upvar command} {
302 
    proc p1 {} {upvar 0 a b; upvar 0 b a}
303 
    list [catch p1 msg] $msg
304 
} {1 {can't upvar from variable to itself}}
305 
test upvar-8.6 {errors in upvar command} {
306 
    proc p1 {} {set a 33; upvar b a}
307 
    list [catch p1 msg] $msg
308 
} {1 {variable "a" already exists}}
309 
test upvar-8.7 {errors in upvar command} {
310 
    proc p1 {} {trace variable a w foo; upvar b a}
311 
    list [catch p1 msg] $msg
312 
} {1 {variable "a" has traces: can't use for upvar}}
313 
test upvar-8.8 {create nested array with upvar} {
314 
    proc p1 {} {upvar x(a) b; set b(2) 44}
315 
    catch {unset x}
316 
    list [catch p1 msg] $msg
317 
} {1 {can't set "b(2)": variable isn't array}}
318 
test upvar-8.9 {upvar won't create namespace variable that refers to procedure variable} {
319 
    catch {eval namespace delete [namespace children :: test_ns_*]}
320 
    catch {rename MakeLink ""}
321 
    namespace eval ::test_ns_1 {}
322 
    proc MakeLink {a} {
323 
        namespace eval ::test_ns_1 {
324 
            upvar a a
325 
        }
326 
        unset ::test_ns_1::a
327 
    }
328 
    list [catch {MakeLink 1} msg] $msg
329 
} {1 {bad variable name "a": upvar won't create namespace variable that refers to procedure variable}}
330 
test upvar-8.10 {upvar will create element alias for new array element} {
331 
    catch {unset upvarArray}
332 
    array set upvarArray {}
333 
    catch {upvar 0 upvarArray(elem) upvarArrayElemAlias}
334 
} {0}
335 
 
336 
if {[info commands testupvar] != {}} {
337 
    test upvar-9.1 {Tcl_UpVar2 procedure} {
338 
        list [catch {testupvar xyz a {} x global} msg] $msg
339 
    } {1 {bad level "xyz"}}
340 
    test upvar-9.2 {Tcl_UpVar2 procedure} {
341 
        catch {unset a}
342 
        catch {unset x}
343 
        set a 44
344 
        list [catch {testupvar #0 a 1 x global} msg] $msg
345 
    } {1 {can't access "a(1)": variable isn't array}}
346 
    test upvar-9.3 {Tcl_UpVar2 procedure} {
347 
        proc foo {} {
348 
            testupvar 1 a {} x local
349 
            set x
350 
        }
351 
        catch {unset a}
352 
        catch {unset x}
353 
        set a 44
354 
        foo
355 
    } {44}
356 
    test upvar-9.4 {Tcl_UpVar2 procedure} {
357 
        proc foo {} {
358 
            testupvar 1 a {} _up_ global
359 
            list [catch {set x} msg] $msg
360 
        }
361 
        catch {unset a}
362 
        catch {unset _up_}
363 
        set a 44
364 
        concat [foo] $_up_
365 
    } {1 {can't read "x": no such variable} 44}
366 
    test upvar-9.5 {Tcl_UpVar2 procedure} {
367 
        proc foo {} {
368 
            testupvar 1 a b x local
369 
            set x
370 
        }
371 
        catch {unset a}
372 
        catch {unset x}
373 
        set a(b) 1234
374 
        foo
375 
    } {1234}
376 
    test upvar-9.6 {Tcl_UpVar procedure} {
377 
        proc foo {} {
378 
            testupvar 1 a x local
379 
            set x
380 
        }
381 
        catch {unset a}
382 
        catch {unset x}
383 
        set a xyzzy
384 
        foo
385 
    } {xyzzy}
386 
    test upvar-9.7 {Tcl_UpVar procedure} {
387 
        proc foo {} {
388 
            testupvar #0 a(b) x local
389 
            set x
390 
        }
391 
        catch {unset a}
392 
        catch {unset x}
393 
        set a(b) 1234
394 
        foo
395 
    } {1234}
396 
}
397 
catch {unset a}
398 
 
399 
concat

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.