diff options
Diffstat (limited to 'tests/result.test')
| -rw-r--r-- | tests/result.test | 86 |
1 files changed, 60 insertions, 26 deletions
diff --git a/tests/result.test b/tests/result.test index e8418e2..22419e3 100644 --- a/tests/result.test +++ b/tests/result.test @@ -9,18 +9,16 @@ # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# SCCS: @(#) result.test 1.4 97/12/08 15:07:49 -if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest - namespace import -force ::tcltest::* -} +package require tcltest 2 +namespace import ::tcltest::* # Some tests require the testsaveresult command -set ::tcltest::testConstraints(testsaveresult) \ - [expr {[info commands testsaveresult] != {}}] +testConstraint testsaveresult [llength [info commands testsaveresult]] +testConstraint testsetobjerrorcode [llength [info commands testsetobjerrorcode]] +testConstraint testseterrorcode [llength [info commands testseterrorcode]] +testConstraint testreturn [llength [info commands testreturn]] test result-1.1 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult small {set x 42} 0 @@ -65,39 +63,75 @@ test result-3.2 {Tcl_DiscardInterpResult} {testsaveresult} { testsaveresult free {set x 42} 1 } {42} -test result-4.1 {Tcl_SetObjErrorCode - one arg} {testsaveresult} { +test result-4.1 {Tcl_SetObjErrorCode - one arg} {testsetobjerrorcode} { catch {testsetobjerrorcode 1} list [set errorCode] } {1} -test result-4.2 {Tcl_SetObjErrorCode - two args} {testsaveresult} { +test result-4.2 {Tcl_SetObjErrorCode - two args} {testsetobjerrorcode} { catch {testsetobjerrorcode 1 2} list [set errorCode] } {{1 2}} -test result-4.3 {Tcl_SetObjErrorCode - three args} {testsaveresult} { +test result-4.3 {Tcl_SetObjErrorCode - three args} {testsetobjerrorcode} { catch {testsetobjerrorcode 1 2 3} list [set errorCode] } {{1 2 3}} -test result-4.4 {Tcl_SetObjErrorCode - four args} {testsaveresult} { +test result-4.4 {Tcl_SetObjErrorCode - four args} {testsetobjerrorcode} { catch {testsetobjerrorcode 1 2 3 4} list [set errorCode] } {{1 2 3 4}} -test result-4.5 {Tcl_SetObjErrorCode - five args} {testsaveresult} { +test result-4.5 {Tcl_SetObjErrorCode - five args} {testsetobjerrorcode} { catch {testsetobjerrorcode 1 2 3 4 5} list [set errorCode] } {{1 2 3 4 5}} +test result-5.1 {Tcl_SetErrorCode - one arg} testseterrorcode { + catch {testseterrorcode 1} + set errorCode +} 1 +test result-5.2 {Tcl_SetErrorCode - one arg, list quoting} testseterrorcode { + catch {testseterrorcode {a b}} + set errorCode +} {{a b}} +test result-5.3 {Tcl_SetErrorCode - one arg, list quoting} testseterrorcode { + catch {testseterrorcode \{} + llength $errorCode +} 1 +test result-5.4 {Tcl_SetErrorCode - two args, list quoting} testseterrorcode { + catch {testseterrorcode {a b} c} + set errorCode +} {{a b} c} + +test result-6.0 {Bug 1209759} -constraints testreturn -body { + # Might panic if bug is not fixed. + proc foo {} {testreturn} + foo +} -returnCodes ok -result {} +test result-6.1 {Bug 1209759} -constraints testreturn -body { + # Might panic if bug is not fixed. + proc foo {} {catch {return -level 2}; testreturn} + foo +} -cleanup { + rename foo {} +} -returnCodes ok -result {} +test result-6.2 {Bug 1649062} -setup { + proc foo {} { + if {[catch { + return -code error -errorinfo custom -errorcode CUSTOM foo + } err]} { + return [list $err $::errorCode $::errorInfo] + } + } + set ::errorInfo {} + set ::errorCode {} +} -body { + foo +} -cleanup { + rename foo {} +} -result {foo {} {}} +test result-6.3 {Bug 2383005} { + catch {return -code error -errorcode {{}a} eek} m + set m +} {bad -errorcode value: expected a list but got "{}a"} # cleanup -::tcltest::cleanupTests +cleanupTests return - - - - - - - - - - - - |
