diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | generic/tclInterp.c | 8 | ||||
| -rw-r--r-- | tests/interp.test | 37 |
3 files changed, 42 insertions, 7 deletions
@@ -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 |