summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2004-11-18 21:00:45 (GMT)
committerdgp <dgp@users.sourceforge.net>2004-11-18 21:00:45 (GMT)
commitb2e8fcd688f767931f85ced3ae6a245806a86bca (patch)
treee6fb96b92ad8640eb3498b1db3dae46ba306226e
parentf72504c3281795246a5bfa6ddea712e115adc028 (diff)
downloadtcl-b2e8fcd688f767931f85ced3ae6a245806a86bca.zip
tcl-b2e8fcd688f767931f85ced3ae6a245806a86bca.tar.gz
tcl-b2e8fcd688f767931f85ced3ae6a245806a86bca.tar.bz2
* tests/interp.test (interp-36.*): [interp bgerror] tests.
* generic/tclInterp.c: Corrected [interp bgerror] error messages.
-rw-r--r--ChangeLog4
-rw-r--r--generic/tclInterp.c8
-rw-r--r--tests/interp.test37
3 files changed, 42 insertions, 7 deletions
diff --git a/ChangeLog b/ChangeLog
index 927928d..e1ba325 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -7,7 +7,9 @@
* tests/socket.test:
* tests/timer.test:
- * generic/tclInterp.c: Corrected [interp bgerror] error message.
+ * tests/interp.test (interp-36.*): [interp bgerror] tests.
+
+ * generic/tclInterp.c: Corrected [interp bgerror] error messages.
2004-11-18 Reinhard Max <max@suse.de>
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 8f968ba..21571d4 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInterp.c,v 1.50 2004/11/18 19:22:12 dgp Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.51 2004/11/18 21:00:50 dgp Exp $
*/
#include "tclInt.h"
@@ -2029,10 +2029,8 @@ SlaveBgerror(interp, slaveInterp, objc, objv)
if (objc) {
int length;
- if (TCL_ERROR == Tcl_ListObjLength(interp, objv[0], &length)) {
- return TCL_ERROR;
- }
- if (length < 1) {
+ if (TCL_ERROR == Tcl_ListObjLength(NULL, objv[0], &length)
+ || (length < 1)) {
Tcl_AppendResult(interp, "cmdPrefix must be list of length >= 1",
(char *) NULL);
return TCL_ERROR;
diff --git a/tests/interp.test b/tests/interp.test
index 53c64e5..244a750 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: interp.test,v 1.42 2004/11/13 00:19:10 dgp Exp $
+# RCS: @(#) $Id: interp.test,v 1.43 2004/11/18 21:00:51 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -3211,6 +3211,41 @@ test interp-35.22 {interp time limits normalize milliseconds} -body {
interp delete $i
} -result {2 500}
+test interp-36.1 {interp bgerror syntax} -body {
+ interp bgerror
+} -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"}
+test interp-36.2 {interp bgerror syntax} -body {
+ interp bgerror x y z
+} -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"}
+test interp-36.3 {interp bgerror syntax} -setup {
+ interp create slave
+} -body {
+ slave bgerror x y
+} -cleanup {
+ interp delete slave
+} -returnCodes error -result {wrong # args: should be "slave bgerror ?cmdPrefix?"}
+test interp-36.4 {SlaveBgerror syntax} -setup {
+ interp create slave
+} -body {
+ slave bgerror \{
+} -cleanup {
+ interp delete slave
+} -returnCodes error -result {cmdPrefix must be list of length >= 1}
+test interp-36.5 {SlaveBgerror syntax} -setup {
+ interp create slave
+} -body {
+ slave bgerror {}
+} -cleanup {
+ interp delete slave
+} -returnCodes error -result {cmdPrefix must be list of length >= 1}
+test interp-36.6 {SlaveBgerror returns handler} -setup {
+ interp create slave
+} -body {
+ slave bgerror {foo bar soom}
+} -cleanup {
+ interp delete slave
+} -result {foo bar soom}
+
# cleanup
foreach i [interp slaves] {
interp delete $i