From 100dd6f8cbd58105f48abd5923dfcad39e8392cf Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 22 Sep 2004 03:19:50 +0000 Subject: * generic/tclCompCmds.c: Tolerate [append] syntax errors * tests/appendComp.test (8.1): at compile time, and allow runtime to raise the error (or succeed if a redefined [append] allows). --- ChangeLog | 4 ++++ generic/tclCompCmds.c | 8 ++------ tests/appendComp.test | 18 ++++++++++++++++-- 3 files changed, 22 insertions(+), 8 deletions(-) diff --git a/ChangeLog b/ChangeLog index 99a8b75..18d8747 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,9 @@ 2004-09-21 Don Porter + * generic/tclCompCmds.c: Tolerate [append] syntax errors + * tests/appendComp.test (8.1): at compile time, and allow runtime + to raise the error (or succeed if a redefined [append] allows). + * generic/tclBasic.c: Reworked management of the interp * generic/tclCompile.c: flag ERR_ALREADY_LOGGED, to reduce * generic/tclExecute.c: its exposure. Still left several diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index a368383..486beaa 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.56 2004/02/17 20:55:33 dkf Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.57 2004/09/22 03:19:52 dgp Exp $ */ #include "tclInt.h" @@ -80,11 +80,7 @@ TclCompileAppendCmd(interp, parsePtr, envPtr) numWords = parsePtr->numWords; if (numWords == 1) { - Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), - "wrong # args: should be \"append varName ?value value ...?\"", - -1); - return TCL_ERROR; + return TCL_OUT_LINE_COMPILE; } else if (numWords == 2) { /* * append varName == set varName diff --git a/tests/appendComp.test b/tests/appendComp.test index 9eaff48..4f4cb8b 100644 --- a/tests/appendComp.test +++ b/tests/appendComp.test @@ -11,10 +11,10 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: appendComp.test,v 1.6 2004/05/25 15:33:28 dkf Exp $ +# RCS: @(#) $Id: appendComp.test,v 1.7 2004/09/22 03:19:52 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest + package require tcltest 2 namespace import -force ::tcltest::* } catch {unset x} @@ -351,6 +351,20 @@ test appendComp-7.9 {append var does not trigger read trace} { bar } {0} +test appendComp-8.1 {TCL_OUT_LINE_COMPILE, not TCL_ERROR} -setup { + interp create slave +} -body { + slave eval { + proc foo {} { + proc append args {} + append + } + foo + } +} -cleanup { + interp delete slave +} -result {} + catch {unset i x result y} catch {rename foo ""} catch {rename bar ""} -- cgit v0.12