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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [uplevel.test] - Blame information for rev 1774

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.