1#
2# tryeval.test
3#
4# Tests for the try_eval command.
5#---------------------------------------------------------------------------
6# Copyright 1997-1999 Karl Lehenbauer and Mark Diekhans.
7#
8# Permission to use, copy, modify, and distribute this software and its
9# documentation for any purpose and without fee is hereby granted, provided
10# that the above copyright notice appear in all copies.  Karl Lehenbauer and
11# Mark Diekhans make no representations about the suitability of this
12# software for any purpose.  It is provided "as is" without express or
13# implied warranty.
14#------------------------------------------------------------------------------
15# $Id: tryeval.test,v 1.3 2002/04/04 06:10:30 hobbs Exp $
16#------------------------------------------------------------------------------
17#
18
19if {[cequal [info procs Test] {}]} {
20    source [file join [file dirname [info script]] testlib.tcl]
21}
22
23#
24# Use a proc to do some tests to see if errorInfo and errorCode are preserved
25# and imported correctly.
26#
27proc test_try_eval {code catch {finally {}}} {
28    try_eval $code $catch $finally
29}
30
31proc test_try_eval_results {code catch {finally {}}} {
32    set code [catch {test_try_eval $code $catch $finally} result]
33    global errorInfo errorCode
34    return [list $code $result $errorInfo $errorCode]
35}
36
37proc init_error_vars {errorInfoVal errorCodeVal} {
38    global errorInfo errorCode
39    set errorInfo $errorInfoVal
40    set errorCode $errorCodeVal
41}
42
43test try_eval-1.1 {try_eval argument checking} {
44    list [catch {try_eval} msg] $msg
45} {1 {wrong # args: try_eval code catch ?finally?}}
46
47test try_eval-1.2 {try_eval argument checking} {
48    list [catch {try_eval badcommand} msg] $msg
49} {1 {wrong # args: try_eval code catch ?finally?}}
50
51test try_eval-1.3 {try_eval argument checking} {
52    list [catch {try_eval badcommand badcommand2 badcommand3 badcommand4} msg]\
53	    $msg
54} {1 {wrong # args: try_eval code catch ?finally?}}
55
56test try_eval-2.1 {try_eval ok result} {
57    init_error_vars "errorInfo-2.1" "errorCode-2.1"
58    set result [test_try_eval_results {
59        concat "try_eval result 2.1"
60    } {
61        error "error should not execute"
62    } {
63        global final
64        set final "finally-2.1"
65        concat "finally result should not be returned"
66    }]
67    global final
68    concat $result $final
69} {0 {try_eval result 2.1} errorInfo-2.1 errorCode-2.1 finally-2.1}
70
71test try_eval-2.2 {try_eval ok result} {
72    init_error_vars "errorInfo-2.2" "errorCode-2.2"
73    set result [test_try_eval_results {
74        concat "try_eval result 2.2"
75    } {
76        error "error should not execute"
77    }
78    ]
79    list $result
80} {{0 {try_eval result 2.2} errorInfo-2.2 errorCode-2.2}}
81
82
83test try_eval-2.3 {try_eval ok result} {
84    init_error_vars "errorInfo-2.3" "errorCode-2.3"
85    set result [test_try_eval_results {
86        concat "try_eval result 2.3"
87    } {} {
88        global final
89        set final "finally-2.3"
90        concat "finally result should not be returned"
91    }
92    ]
93    global final
94    concat $result $final
95} {0 {try_eval result 2.3} errorInfo-2.3 errorCode-2.3 finally-2.3}
96
97test try_eval-3.1 {try_eval error result} {
98    init_error_vars "errorInfo-3.1" "errorCode-3.1"
99    set result [test_try_eval_results {
100        error "try_eval error 3.1" errorInfo-error-3.1 errorCode-error-3.1
101    } {
102        error "cont: $errorResult" "cont: $errorInfo" "cont: $errorCode"
103    } {
104        catch {error bow wow arf} ;# Hose errorInfo/Code
105        global final
106        set final "finally-3.1"
107        concat "finally result should not be returned"
108    }
109    ]
110    global final
111    concat $result $final
112} {1 {cont: try_eval error 3.1} {cont: errorInfo-error-3.1
113    invoked from within
114"try_eval $code $catch $finally"
115    (procedure "test_try_eval" line 2)
116    invoked from within
117"test_try_eval $code $catch $finally"} {cont: errorCode-error-3.1} finally-3.1}
118
119
120test try_eval-3.2 {try_eval error result} {
121    init_error_vars "errorInfo-3.2" "errorCode-3.2"
122    set result [test_try_eval_results {
123        error "try_eval error 3.2" errorInfo-error-3.2 errorCode-error-3.2
124    } {
125        error "cont: $errorResult" "cont: $errorInfo" "cont: $errorCode"
126    }
127    ]
128    list $result
129} {{1 {cont: try_eval error 3.2} {cont: errorInfo-error-3.2
130    invoked from within
131"try_eval $code $catch $finally"
132    (procedure "test_try_eval" line 2)
133    invoked from within
134"test_try_eval $code $catch $finally"} {cont: errorCode-error-3.2}}}
135
136
137test try_eval-3.3 {try_eval error result} {
138    init_error_vars "errorInfo-3.3" "errorCode-3.3"
139    set result [test_try_eval_results {
140        error "try_eval error 3.3" errorInfo-error-3.3 errorCode-error-3.3
141    } {} {
142        catch {error bow wow arf} ;# Hose errorInfo/Code
143        global final
144        set final "finally-3.3"
145        concat "finally result should not be returned"
146    }
147    ]
148    global final
149    concat $result $final
150} {1 {try_eval error 3.3} {errorInfo-error-3.3
151    invoked from within
152"try_eval $code $catch $finally"
153    (procedure "test_try_eval" line 2)
154    invoked from within
155"test_try_eval $code $catch $finally"} errorCode-error-3.3 finally-3.3}
156
157test try_eval-3.4 {try_eval error result} {
158    init_error_vars "errorInfo-3.4" "errorCode-3.4"
159    set result [test_try_eval_results {
160        error "try_eval error 3.4" errorInfo-error-3.4 errorCode-error-3.4
161    } {} {
162        catch {error bow wow arf} ;# Hose errorInfo/Code
163        global final
164        set final "finally-3.4"
165        concat "finally result should not be returned"
166    }
167    ]
168    global final
169    list $result $final
170} {{1 {try_eval error 3.4} {errorInfo-error-3.4
171    invoked from within
172"try_eval $code $catch $finally"
173    (procedure "test_try_eval" line 2)
174    invoked from within
175"test_try_eval $code $catch $finally"} errorCode-error-3.4} finally-3.4}
176
177
178test try_eval-3.5 {try_eval error result} {
179    init_error_vars "errorInfo-3.5" "errorCode-3.5"
180    set result [test_try_eval_results {
181        error "try_eval error 3.5" errorInfo-error-3.5 errorCode-error-3.5
182    } {
183        concat "Ok now 3.5"
184    } {
185        catch {error bow wow arf} ;# Hose errorInfo/Code
186        global final
187        set final "finally-3.5"
188        concat "finally result should not be returned"
189    }
190    ]
191    global final
192    concat $result $final
193} {0 {Ok now 3.5} errorInfo-error-3.5 errorCode-error-3.5 finally-3.5}
194
195test try_eval-3.6 {try_eval error result} {
196    init_error_vars "errorInfo-3.6" "errorCode-3.6"
197    set result [test_try_eval_results {
198        error "try_eval error 3.6" errorInfo-error-3.6 errorCode-error-3.6
199    } {
200        concat "Ok now 3.6"
201    }
202    ]
203    list $result
204} {{0 {Ok now 3.6} errorInfo-error-3.6 errorCode-error-3.6}}
205
206
207# cleanup
208::tcltest::cleanupTests
209return
210