blob: 0d768652a5e874221d6a9f22e1dc8ccb8842b525 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
source [file dirname [info script]]/testing.tcl
needs cmd try tclcompat
test try-1.1 "Simple case" {
try {
set x 0
} finally {
incr x
}
} 0
test try-1.2 "Error in body" {
list [catch {
try {
set x 0
error message
} finally {
incr x
}
} msg] $msg $x
} {1 message 1}
test try-1.3 "Error in finally" {
list [catch {
try {
set x 0
} finally {
incr x
error finally
}
} msg] $msg $x
} {1 finally 1}
test try-1.4 "Error in both" {
list [catch {
try {
set x 0
error message
} finally {
incr x
error finally
}
} msg] $msg $x
} {1 finally 1}
test try-1.5 "break in body" {
list [catch {
try {
set x 0
break
} finally {
incr x
}
} msg] $msg $x
} {3 {} 1}
test try-1.6 "break in finally" {
list [catch {
try {
set x 0
} finally {
incr x
break
}
} msg] $msg $x
} {3 {} 1}
test try-1.7 "return value from try, not finally" {
list [catch {
try {
set x 0
} finally {
incr x
}
} msg] $msg $x
} {0 0 1}
test try-1.8 "return from within try" {
proc a {} {
try {
return 1
}
# notreached
return 2
}
a
} {1}
test try-1.9 "return -code from within try" {
proc a {} {
try {
return -code break text
}
# notreached
return 2
}
list [catch a msg] $msg
} {3 text}
test try-2.1 "try ... trap" -body {
proc a {} {
return -code error -errorcode {CUSTOM RESULT} "custom errorcode"
}
try {
a
} trap CUSTOM {msg opts} {
list $msg $opts(-code) $opts(-errorcode)
}
} -result {{custom errorcode} 1 {CUSTOM RESULT}}
test try-2.2 "trap single match" {
try {
apply {{} {return -code error -errorcode {FOO BAR} failed}}
} trap FOO {msg opts} {
list trapped
}
} trapped
test try-2.3 "trap two matches" {
try {
apply {{} {return -code error -errorcode {FOO BAR} failed}}
} trap {FOO BAR} {msg opts} {
list trapped
}
} trapped
test try-2.4 "trap no match" -body {
try {
apply {{} {return -code error -errorcode {FOO BAR} failed}}
} trap BAZ {msg opts} {
list trapped
}
} -returnCodes error -result failed
test try-2.5 "trap match first but not second" -body {
try {
apply {{} {return -code error -errorcode {FOO BAR} failed}}
} trap {FOO BAZ} {msg opts} {
list trapped
}
} -returnCodes error -result failed
proc c {} {
try {
error here
} on error {msg opts} {
# jim can do simply:
if {[catch {incr opts(-level)}]} {
# Must be Tcl
dict incr opts -level
}
return {*}$opts $msg
}
}
test try-3.1 "rethrow error in try/on handler" {
list [catch c msg] $msg
} {1 here}
testreport
|
