From cdedbaef562cec652a7bbfa9faf73a5ba885facc Mon Sep 17 00:00:00 2001
From: Miguel Sofer <miguel.sofer@gmail.com>
Date: Mon, 10 Dec 2001 20:30:11 +0000
Subject: fix background error reporting in the absence of a bgerror proc [Bug
219142].
---
ChangeLog | 6 ++++++
generic/tclEvent.c | 4 ++--
tests/event.test | 16 +++++++++++++++-
3 files changed, 23 insertions(+), 3 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index a75d1d4..69991a6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2001-12-10 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * generic/tclEvent.c:
+ * tests/event.test: fix background error reporting in the absence
+ of a bgerror proc [Bug 219142].
+
2001-12-10 Don Porter <dgp@users.sourceforge.net>
* doc/Access.3:
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 3ad7234..52d461f 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclEvent.c,v 1.15 2001/10/03 18:28:05 hobbs Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.16 2001/12/10 20:30:13 msofer Exp $
*/
#include "tclInt.h"
@@ -290,7 +290,7 @@ HandleBgErrors(clientData)
int len;
string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &len);
- if (strcmp(string, "\"bgerror\" is an invalid command name or ambiguous abbreviation") == 0) {
+ if (Tcl_FindCommand(interp, "bgerror", NULL, TCL_GLOBAL_ONLY) == NULL) {
Tcl_WriteChars(errChannel, assocPtr->firstBgPtr->errorInfo, -1);
Tcl_WriteChars(errChannel, "\n", -1);
} else {
diff --git a/tests/event.test b/tests/event.test
index 44d6610..ce9e34d 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: event.test,v 1.13 2001/07/31 19:12:07 vincentdarley Exp $
+# RCS: @(#) $Id: event.test,v 1.14 2001/12/10 20:30:13 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -276,6 +276,20 @@ test event-7.4 {tkerror is nothing special anymore to tcl} {
set errRes
} bg:err1
+test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} {
+ set script {
+ after 1000 error hello
+ after 2000 set a 0
+ vwait a
+ }
+
+ list [catch {exec [info nameofexecutable] << $script} errMsg] $errMsg
+} {1 {hello
+ while executing
+"error hello"
+ ("after" script)}}
+
+
# someday : add a test checking that
# when there is no bgerror, an error msg goes to stderr
# ideally one would use sub interp and transfer a fake stderr
--
cgit v0.12