summaryrefslogtreecommitdiffstats
path: root/tcl8.6/tests/result.test
diff options
context:
space:
mode:
Diffstat (limited to 'tcl8.6/tests/result.test')
-rw-r--r--tcl8.6/tests/result.test147
1 files changed, 0 insertions, 147 deletions
diff --git a/tcl8.6/tests/result.test b/tcl8.6/tests/result.test
deleted file mode 100644
index 9e8a66b..0000000
--- a/tcl8.6/tests/result.test
+++ /dev/null
@@ -1,147 +0,0 @@
-# This file tests the routines in tclResult.c.
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
-#
-# 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.
-
-package require tcltest 2
-namespace import ::tcltest::*
-
-::tcltest::loadTestedCommands
-catch [list package require -exact Tcltest [info patchlevel]]
-
-# Some tests require the testsaveresult command
-
-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
-} {small result}
-test result-1.2 {Tcl_SaveInterpResult} {testsaveresult} {
- testsaveresult append {set x 42} 0
-} {append result}
-test result-1.3 {Tcl_SaveInterpResult} {testsaveresult} {
- testsaveresult dynamic {set x 42} 0
-} {dynamic result notCalled present}
-test result-1.4 {Tcl_SaveInterpResult} {testsaveresult} {
- testsaveresult object {set x 42} 0
-} {object result same}
-test result-1.5 {Tcl_SaveInterpResult} {testsaveresult} {
- testsaveresult small {set x 42} 1
-} {42}
-test result-1.6 {Tcl_SaveInterpResult} {testsaveresult} {
- testsaveresult append {set x 42} 1
-} {42}
-test result-1.7 {Tcl_SaveInterpResult} {testsaveresult} {
- testsaveresult dynamic {set x 42} 1
-} {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
-
-test result-2.1 {Tcl_RestoreInterpResult} {testsaveresult} {
- testsaveresult append {cd _foobar} 0
-} {append result}
-
-# 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.2 {Tcl_DiscardInterpResult} {testsaveresult} {
- testsaveresult free {set x 42} 1
-} {42}
-
-test result-4.1 {Tcl_SetObjErrorCode - one arg} {testsetobjerrorcode} {
- catch {testsetobjerrorcode 1}
- list [set errorCode]
-} {1}
-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} {testsetobjerrorcode} {
- catch {testsetobjerrorcode 1 2 3}
- list [set errorCode]
-} {{1 2 3}}
-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} {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"}
-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