118 lines
1.5 KiB
Plaintext
118 lines
1.5 KiB
Plaintext
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}
|
|
|
|
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
|