From 6b2f093c42f3559f40f1c82297d09f5388d596f6 Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Sat, 23 Mar 2002 01:39:56 +0000
Subject: adding test for [Bug 533758], fixed earlier today.
---
ChangeLog | 5 +++++
tests/basic.test | 28 +++++++++++++++++++++++++---
2 files changed, 30 insertions(+), 3 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index d3fe00c..89b89b8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2002-03-22 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * tests/basic.test (basic-46.1): adding test for [Bug 533758],
+ fixed earlier today.
+
2002-03-22 Jeff Hobbs <jeffh@ActiveState.com>
* win/tclWinInt.h: moved undef of TCL_STORAGE_CLASS. [Bug #478579]
diff --git a/tests/basic.test b/tests/basic.test
index 70472a8..4aee121 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -15,7 +15,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: basic.test,v 1.15 2002/02/10 20:36:34 kennykb Exp $
+# RCS: @(#) $Id: basic.test,v 1.16 2002/03/23 01:39:57 msofer Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -558,8 +558,30 @@ test basic-44.1 {Tcl_GlobalEval} {emptyTest} {
test basic-45.1 {Tcl_SetRecursionLimit: see interp.test} {emptyTest} {
} {}
-test basic-46.1 {Tcl_AllowExceptions} {emptyTest} {
-} {}
+test basic-46.1 {Tcl_AllowExceptions: exception return not allowed} {
+ catch {close $f}
+ set res [catch {
+ set f [open |[info nameofexecutable] w+]
+ fconfigure $f -buffering line
+ puts $f {fconfigure stdout -buffering line}
+ puts $f continue
+ puts $f {puts $errorInfo}
+ puts $f {puts DONE}
+ set newMsg {}
+ set msg {}
+ while {$newMsg != "DONE"} {
+ set newMsg [gets $f]
+ append msg "${newMsg}\n"
+ }
+ close $f
+ }]
+ list $res $msg
+} {1 {invoked "continue" outside of a loop
+ while executing
+"continue
+"
+DONE
+}}
# cleanup
catch {eval namespace delete [namespace children :: test_ns_*]}
--
cgit v0.12