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