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

Subversion Repositories or1k

[/] [or1k/] [tags/] [start/] [insight/] [tcl/] [tests/] [uplevel.test] - Blame information for rev 1780

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

Line No. Rev Author Line
1 578 markom 
# Commands covered:  uplevel
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: uplevel.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 
proc a {x y} {
18 
    newset z [expr $x+$y]
19 
    return $z
20 
}
21 
proc newset {name value} {
22 
    uplevel set $name $value
23 
    uplevel 1 {uplevel 1 {set xyz 22}}
24 
}
25 
 
26 
test uplevel-1.1 {simple operation} {
27 
    set xyz 0
28 
    a 22 33
29 
} 55
30 
test uplevel-1.2 {command is another uplevel command} {
31 
    set xyz 0
32 
    a 22 33
33 
    set xyz
34 
} 22
35 
 
36 
proc a1 {} {
37 
    b1
38 
    global a a1
39 
    set a $x
40 
    set a1 $y
41 
}
42 
proc b1 {} {
43 
    c1
44 
    global b b1
45 
    set b $x
46 
    set b1 $y
47 
}
48 
proc c1 {} {
49 
    uplevel 1 set x 111
50 
    uplevel #2 set y 222
51 
    uplevel 2 set x 333
52 
    uplevel #1 set y 444
53 
    uplevel 3 set x 555
54 
    uplevel #0 set y 666
55 
}
56 
a1
57 
test uplevel-2.1 {relative and absolute uplevel} {set a} 333
58 
test uplevel-2.2 {relative and absolute uplevel} {set a1} 444
59 
test uplevel-2.3 {relative and absolute uplevel} {set b} 111
60 
test uplevel-2.4 {relative and absolute uplevel} {set b1} 222
61 
test uplevel-2.5 {relative and absolute uplevel} {set x} 555
62 
test uplevel-2.6 {relative and absolute uplevel} {set y} 666
63 
 
64 
test uplevel-3.1 {uplevel to same level} {
65 
    set x 33
66 
    uplevel #0 set x 44
67 
    set x
68 
} 44
69 
test uplevel-3.2 {uplevel to same level} {
70 
    set x 33
71 
    uplevel 0 set x
72 
} 33
73 
test uplevel-3.3 {uplevel to same level} {
74 
    set y xxx
75 
    proc a1 {} {set y 55; uplevel 0 set y 66; return $y}
76 
    a1
77 
} 66
78 
test uplevel-3.4 {uplevel to same level} {
79 
    set y zzz
80 
    proc a1 {} {set y 55; uplevel #1 set y}
81 
    a1
82 
} 55
83 
 
84 
test uplevel-4.1 {error: non-existent level} {
85 
    list [catch c1 msg] $msg
86 
} {1 {bad level "#2"}}
87 
test uplevel-4.2 {error: non-existent level} {
88 
    proc c2 {} {uplevel 3 {set a b}}
89 
    list [catch c2 msg] $msg
90 
} {1 {bad level "3"}}
91 
test uplevel-4.3 {error: not enough args} {
92 
    list [catch uplevel msg] $msg
93 
} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
94 
test uplevel-4.4 {error: not enough args} {
95 
    proc upBug {} {uplevel 1}
96 
    list [catch upBug msg] $msg
97 
} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
98 
 
99 
proc a2 {} {
100 
    uplevel a3
101 
}
102 
proc a3 {} {
103 
    global x y
104 
    set x [info level]
105 
    set y [info level 1]
106 
}
107 
a2
108 
test uplevel-5.1 {info level} {set x} 1
109 
test uplevel-5.2 {info level} {set y} a3

powered by: WebSVN 2.1.0

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