diff options
Diffstat (limited to 'tests/result.test')
| -rw-r--r-- | tests/result.test | 40 |
1 files changed, 14 insertions, 26 deletions
diff --git a/tests/result.test b/tests/result.test index 5ae29b2..22419e3 100644 --- a/tests/result.test +++ b/tests/result.test @@ -4,19 +4,14 @@ # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # -# Copyright © 1997 Sun Microsystems, Inc. -# Copyright © 1998-1999 Scriptics Corporation. +# Copyright (c) 1997 by Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {"::tcltest" ni [namespace children]} { - package require tcltest 2.5 - namespace import -force ::tcltest::* -} - -::tcltest::loadTestedCommands -catch [list package require -exact tcl::test [info patchlevel]] +package require tcltest 2 +namespace import ::tcltest::* # Some tests require the testsaveresult command @@ -33,7 +28,7 @@ test result-1.2 {Tcl_SaveInterpResult} {testsaveresult} { } {append result} test result-1.3 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult dynamic {set x 42} 0 -} {dynamic result presentOrFreed} +} {dynamic result notCalled present} test result-1.4 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult object {set x 42} 0 } {object result same} @@ -45,11 +40,12 @@ test result-1.6 {Tcl_SaveInterpResult} {testsaveresult} { } {42} test result-1.7 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult dynamic {set x 42} 1 -} {42 presentOrFreed} +} {42 called missing} test result-1.8 {Tcl_SaveInterpResult} {testsaveresult} { testsaveresult object {set x 42} 1 } {42 different} + # Tcl_RestoreInterpResult is mostly tested by the previous tests except # for the following case @@ -60,9 +56,9 @@ test result-2.1 {Tcl_RestoreInterpResult} {testsaveresult} { # Tcl_DiscardInterpResult is mostly tested by the previous tests except # for the following cases -test result-3.1 {Tcl_DiscardInterpResult} -constraints testsaveresult -body { - testsaveresult append {cd _foobar} 1 -} -returnCodes error -result {couldn't change working directory to "_foobar": no such file or directory} +test result-3.1 {Tcl_DiscardInterpResult} {testsaveresult} { + list [catch {testsaveresult append {cd _foobar} 1} msg] $msg +} {1 {couldn't change working directory to "_foobar": no such file or directory}} test result-3.2 {Tcl_DiscardInterpResult} {testsaveresult} { testsaveresult free {set x 42} 1 } {42} @@ -109,14 +105,14 @@ test result-6.0 {Bug 1209759} -constraints testreturn -body { # Might panic if bug is not fixed. proc foo {} {testreturn} foo -} -result {} +} -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 {} -} -result {} +} -returnCodes ok -result {} test result-6.2 {Bug 1649062} -setup { proc foo {} { if {[catch { @@ -133,17 +129,9 @@ test result-6.2 {Bug 1649062} -setup { rename foo {} } -result {foo {} {}} test result-6.3 {Bug 2383005} { - catch {return -code error -errorcode {{}a} eek} m - set m + catch {return -code error -errorcode {{}a} eek} m + set m } {bad -errorcode value: expected a list but got "{}a"} -test result-6.4 {non-list -errorstack} -body { - catch {return -code error -errorstack {{}a} eek} m o - list $m [dict get $o -errorcode] [dict get $o -errorstack] -} -match glob -result {{bad -errorstack value: expected a list but got "{}a"} {TCL RESULT NONLIST_ERRORSTACK} {INNER * UP 1}} -test result-6.5 {odd-sized-list -errorstack} -body { - catch {return -code error -errorstack a eek} m o - list $m [dict get $o -errorcode] [dict get $o -errorstack] -} -match glob -result {{forbidden odd-sized list for -errorstack: "a"} {TCL RESULT ODDSIZEDLIST_ERRORSTACK} {INNER * UP 1}} # cleanup cleanupTests return |