diff options
Diffstat (limited to 'tests/proc-old.test')
| -rw-r--r-- | tests/proc-old.test | 108 |
1 files changed, 51 insertions, 57 deletions
diff --git a/tests/proc-old.test b/tests/proc-old.test index a57e147..e45cf5c 100644 --- a/tests/proc-old.test +++ b/tests/proc-old.test @@ -13,11 +13,10 @@ # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# RCS: @(#) $Id: proc-old.test,v 1.3 1999/04/16 00:47:32 stanton Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] + package require tcltest + namespace import -force ::tcltest::* } catch {rename t1 ""} @@ -159,80 +158,80 @@ test proc-old-3.9 {local and global arrays} { } {{w t1}} catch {unset a} -test proc-old-3.1 {arguments and defaults} { +test proc-old-30.1 {arguments and defaults} { proc tproc {x y z} { return [list $x $y $z] } tproc 11 12 13 } {11 12 13} -test proc-old-3.2 {arguments and defaults} { +test proc-old-30.2 {arguments and defaults} { proc tproc {x y z} { return [list $x $y $z] } list [catch {tproc 11 12} msg] $msg -} {1 {no value given for parameter "z" to "tproc"}} -test proc-old-3.3 {arguments and defaults} { +} {1 {wrong # args: should be "tproc x y z"}} +test proc-old-30.3 {arguments and defaults} { proc tproc {x y z} { return [list $x $y $z] } list [catch {tproc 11 12 13 14} msg] $msg -} {1 {called "tproc" with too many arguments}} -test proc-old-3.4 {arguments and defaults} { +} {1 {wrong # args: should be "tproc x y z"}} +test proc-old-30.4 {arguments and defaults} { proc tproc {x {y y-default} {z z-default}} { return [list $x $y $z] } tproc 11 12 13 } {11 12 13} -test proc-old-3.5 {arguments and defaults} { +test proc-old-30.5 {arguments and defaults} { proc tproc {x {y y-default} {z z-default}} { return [list $x $y $z] } tproc 11 12 } {11 12 z-default} -test proc-old-3.6 {arguments and defaults} { +test proc-old-30.6 {arguments and defaults} { proc tproc {x {y y-default} {z z-default}} { return [list $x $y $z] } tproc 11 } {11 y-default z-default} -test proc-old-3.7 {arguments and defaults} { +test proc-old-30.7 {arguments and defaults} { proc tproc {x {y y-default} {z z-default}} { return [list $x $y $z] } list [catch {tproc} msg] $msg -} {1 {no value given for parameter "x" to "tproc"}} -test proc-old-3.8 {arguments and defaults} { +} {1 {wrong # args: should be "tproc x ?y? ?z?"}} +test proc-old-30.8 {arguments and defaults} { list [catch { proc tproc {x {y y-default} z} { return [list $x $y $z] } tproc 2 3 } msg] $msg -} {1 {no value given for parameter "z" to "tproc"}} -test proc-old-3.9 {arguments and defaults} { +} {1 {wrong # args: should be "tproc x ?y? z"}} +test proc-old-30.9 {arguments and defaults} { proc tproc {x {y y-default} args} { return [list $x $y $args] } tproc 2 3 4 5 } {2 3 {4 5}} -test proc-old-3.10 {arguments and defaults} { +test proc-old-30.10 {arguments and defaults} { proc tproc {x {y y-default} args} { return [list $x $y $args] } tproc 2 3 } {2 3 {}} -test proc-old-3.11 {arguments and defaults} { +test proc-old-30.11 {arguments and defaults} { proc tproc {x {y y-default} args} { return [list $x $y $args] } tproc 2 } {2 y-default {}} -test proc-old-3.12 {arguments and defaults} { +test proc-old-30.12 {arguments and defaults} { proc tproc {x {y y-default} args} { return [list $x $y $args] } list [catch {tproc} msg] $msg -} {1 {no value given for parameter "x" to "tproc"}} +} {1 {wrong # args: should be "tproc x ?y? ?arg ...?"}} test proc-old-4.1 {variable numbers of arguments} { proc tproc args {return $args} @@ -257,7 +256,7 @@ test proc-old-4.5 {variable numbers of arguments} { test proc-old-4.6 {variable numbers of arguments} { proc tproc {x missing args} {return $args} list [catch {tproc 1} msg] $msg -} {1 {no value given for parameter "missing" to "tproc"}} +} {1 {wrong # args: should be "tproc x missing ?arg ...?"}} test proc-old-5.1 {error conditions} { list [catch {proc} msg] $msg @@ -273,19 +272,16 @@ test proc-old-5.4 {error conditions} { } {1 {unmatched open brace in list}} test proc-old-5.5 {error conditions} { list [catch {proc tproc {{} y} {return foo}} msg] $msg -} {1 {procedure "tproc" has argument with no name}} +} {1 {argument with no name}} test proc-old-5.6 {error conditions} { list [catch {proc tproc {{} y} {return foo}} msg] $msg -} {1 {procedure "tproc" has argument with no name}} +} {1 {argument with no name}} test proc-old-5.7 {error conditions} { list [catch {proc tproc {{x 1 2} y} {return foo}} msg] $msg } {1 {too many fields in argument specifier "x 1 2"}} test proc-old-5.8 {error conditions} { catch {return} } 2 -test proc-old-5.9 {error conditions} { - list [catch {global} msg] $msg -} {1 {wrong # args: should be "global varName ?varName ...?"}} proc tproc {} { set a 22 global a @@ -315,7 +311,7 @@ test proc-old-5.13 {error conditions} { return } catch tproc msg - set errorInfo + set ::errorInfo } {error in procedure while executing "error "error in procedure"" @@ -329,9 +325,10 @@ test proc-old-5.14 {error conditions} { return } catch tproc msg - set errorInfo + set ::errorInfo } {invoked "break" outside of a loop - while executing + (procedure "tproc" line 1) + invoked from within "tproc"} test proc-old-5.15 {error conditions} { proc tproc {} { @@ -340,9 +337,10 @@ test proc-old-5.15 {error conditions} { return } catch tproc msg - set errorInfo + set ::errorInfo } {invoked "continue" outside of a loop - while executing + (procedure "tproc" line 1) + invoked from within "tproc"} test proc-old-5.16 {error conditions} { proc foo args { @@ -357,7 +355,7 @@ test proc-old-5.16 {error conditions} { } } set fooMsg "foo not called" - list [catch tproc msg] $msg $errorInfo $fooMsg + list [catch tproc msg] $msg $::errorInfo $fooMsg } {1 {Nested error} {Nested error while executing "error "Nested error"" @@ -392,7 +390,7 @@ test proc-old-7.1 {return with special completion code} { list [catch {tproc ok} msg] $msg } {0 abc} test proc-old-7.2 {return with special completion code} { - list [catch {tproc error} msg] $msg $errorInfo $errorCode + list [catch {tproc error} msg] $msg $::errorInfo $::errorCode } {1 abc {abc while executing "tproc error"} NONE} @@ -408,12 +406,12 @@ test proc-old-7.5 {return with special completion code} { test proc-old-7.6 {return with special completion code} { list [catch {tproc -14} msg] $msg } {-14 abc} -test proc-old-7.7 {return with special completion code} { - list [catch {tproc gorp} msg] $msg -} {1 {bad completion code "gorp": must be ok, error, return, break, continue, or an integer}} -test proc-old-7.8 {return with special completion code} { - list [catch {tproc 10b} msg] $msg -} {1 {bad completion code "10b": must be ok, error, return, break, continue, or an integer}} +test proc-old-7.7 {return with special completion code} -body { + tproc err +} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer} +test proc-old-7.8 {return with special completion code} -body { + tproc 10b +} -returnCodes error -match glob -result {bad completion code "10b": must be ok, error, return, break, continue*, or an integer} test proc-old-7.9 {return with special completion code} { proc tproc2 {} { tproc return @@ -432,7 +430,9 @@ test proc-old-7.11 {return with special completion code} { catch {open _bad_file_name r} msg return -code error -errorinfo $errorInfo -errorcode $errorCode $msg } - normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode] + set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode] + regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg + normalizeMsg $msg } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory while executing "open _bad_file_name r" @@ -444,7 +444,9 @@ test proc-old-7.12 {return with special completion code} { catch {open _bad_file_name r} msg return -code error -errorcode $errorCode $msg } - normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode] + set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode] + regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg + normalizeMsg $msg } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory while executing "tproc2"} {posix enoent {no such file or directory}}} @@ -454,7 +456,9 @@ test proc-old-7.13 {return with special completion code} { catch {open _bad_file_name r} msg return -code error -errorinfo $errorInfo $msg } - normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode] + set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode] + regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg + normalizeMsg $msg } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory while executing "open _bad_file_name r" @@ -466,13 +470,15 @@ test proc-old-7.14 {return with special completion code} { catch {open _bad_file_name r} msg return -code error $msg } - normalizeMsg [list [catch tproc2 msg] $msg $errorInfo $errorCode] + set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode] + regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg + normalizeMsg $msg } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory while executing "tproc2"} none} -test proc-old-7.14 {return with special completion code} { +test proc-old-7.15 {return with special completion code} { list [catch {return -badOption foo message} msg] $msg -} {1 {bad option "-badOption": must be -code, -errorcode, or -errorinfo}} +} {2 message} test proc-old-8.1 {unset and undefined local arrays} { proc t1 {} { @@ -509,15 +515,3 @@ catch {rename t1 ""} catch {rename foo ""} ::tcltest::cleanupTests return - - - - - - - - - - - - |