From 34d0a97402b92ffaea87cbe40088ac100e9c6361 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 15 Aug 2010 16:12:26 +0000 Subject: * generic/tclProc.c (ProcWrongNumArgs): [Bug 3045010]: Make the handling of passing the wrong number of arguments to [apply] somewhat less verbose when a lambda term is present. --- ChangeLog | 83 ++++++++++++++++++++++++++------------------------ generic/tclProc.c | 14 +++++---- tests/apply.test | 91 +++++++++++++++++++++++++++---------------------------- 3 files changed, 96 insertions(+), 92 deletions(-) diff --git a/ChangeLog b/ChangeLog index c61ebd0..cd66dfb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,35 +1,41 @@ +2010-08-15 Donal K. Fellows + + * generic/tclProc.c (ProcWrongNumArgs): [Bug 3045010]: Make the + handling of passing the wrong number of arguments to [apply] somewhat + less verbose when a lambda term is present. + 2010-08-14 Jan Nijtmans - * compat/unicows Remove completely, see Feature Req #2819611 - * doc/FileSystem.3 [Patch #2994165] Change signature of + * compat/unicows: Remove completely, see [FRQ 2819611]. + * doc/FileSystem.3: [Patch 2994165]: Change signature of * generic/tcl.decls Tcl_FSGetNativePath and TclpDeleteFile - * generic/tclDecls.h - * generic/tclIOUtil.c - * generic/tclStubInit.c - * generic/tclInt.h - * unix/tclUnixFCmd.c - * win/tclWinFCmd.c - * doc/Hash.3 [Patch 3009403] Signature of Tcl_GetHashKey, - * generic/tcl.h Tcl_(Create|Find)HashEntry + * generic/tclDecls.h: + * generic/tclIOUtil.c: + * generic/tclStubInit.c: + * generic/tclInt.h: + * unix/tclUnixFCmd.c: + * win/tclWinFCmd.c: + * doc/Hash.3: [Patch 3009403]: Signature of Tcl_GetHashKey, + * generic/tcl.h: Tcl_(Create|Find)HashEntry 2010-08-11 Jeff Hobbs - * unix/ldAix: remove ancient (pre-4.2) AIX support - * unix/configure: regen with ac-2.59 + * unix/ldAix: Remove ancient (pre-4.2) AIX support + * unix/configure: Regen with ac-2.59 * unix/configure.in, unix/tclConfig.sh.in, unix/Makefile.in: - * unix/tcl.m4 (AIX): remove the need for ldAIX, replace with - -bexpall/-brtl. Remove TCL_EXP_FILE (export file) and other - baggage that went with it. Remove pre-4 AIX build support. + * unix/tcl.m4 (AIX): Remove the need for ldAIX, replace with + -bexpall/-brtl. Remove TCL_EXP_FILE (export file) and other baggage + that went with it. Remove pre-4 AIX build support. 2010-08-11 Miguel Sofer - * generic/tclBasic.c (TclNRYieldToObjCmd): - * tests/coroutine.test: fixed bad copypasta snafu. - Thanks to Andy Goth for finding the bug. + * generic/tclBasic.c (TclNRYieldToObjCmd): + * tests/coroutine.test: Fixed bad copypasta snafu. Thanks to Andy Goth + for finding the bug. 2010-08-10 Jeff Hobbs - * generic/tclUtil.c (TclByteArrayMatch): patterns may not be + * generic/tclUtil.c (TclByteArrayMatch): Patterns may not be null-terminated, so account for that. 2010-08-09 Don Porter @@ -40,19 +46,18 @@ * win/Makefile.in, win/makefile.bc, win/makefile.vc, win/tcl.dsp: * win/tclWinPipe.c (TclpCreateProcess): - * win/stub16.c (removed): removed Win9x tclpip8x.dll build and - 16-bit application loader stub support. Win9x is no longer - supported. + * win/stub16.c (removed): Removed Win9x tclpip8x.dll build and 16-bit + application loader stub support. Win9x is no longer supported. - * win/tclWin32Dll.c (TclWinInit): hard-enforce Windows 9x as an - unsupported platform with a panic. Code to support it still - exists in other files (to go away in time), but new APIs are being - used that don't exist on Win9x. + * win/tclWin32Dll.c (TclWinInit): Hard-enforce Windows 9x as an + unsupported platform with a panic. Code to support it still exists in + other files (to go away in time), but new APIs are being used that + don't exist on Win9x. - * unix/tclUnixFCmd.c: adjust license header as per + * unix/tclUnixFCmd.c: Adjust license header as per ftp://ftp.cs.berkeley.edu/pub/4bsd/README.Impt.License.Change - * license.terms: fix DFARs note for number-adjusted rights clause + * license.terms: Fix DFARs note for number-adjusted rights clause * win/tclWin32Dll.c (asciiProcs, unicodeProcs): * win/tclWinLoad.c (TclpDlopen): 'load' use LoadLibraryEx with @@ -63,14 +68,14 @@ 2010-08-04 Andreas Kupries - * generic/tclIORChan.c: [Bug 3034840]: Fixed reference counting - * generic/tclIORTrans.c: in InvokeTclMethod and callers. + * generic/tclIORChan.c: [Bug 3034840]: Fixed reference counting in + * generic/tclIORTrans.c: InvokeTclMethod and callers. * tests/ioTrans.test: 2010-08-03 Andreas Kupries - * tests/var.test (var-19.1): [Bug 3037525]: Added test - demonstrating the local hashtable deletion crash and fix. + * tests/var.test (var-19.1): [Bug 3037525]: Added test demonstrating + the local hashtable deletion crash and fix. * tests/info.test (info-39.1): Added forward copy of test in 8.5 branch about [Bug 2933089]. Should not fail, and doesn't, after @@ -86,21 +91,21 @@ * library/tzdata/Pacific/Ponape: * library/tzdata/Pacific/Truk: * library/tzdata/Pacific/Yap: Olson's tzdata2010k. - + 2010-08-02 Miguel Sofer - * generic/tclVar.c: correcting bad port of [Bug 3037525] fix + * generic/tclVar.c: Correcting bad port of [Bug 3037525] fix 2010-07-28 Miguel Sofer - * generic/tclVar.c: fix for crash [Bug 3037525]: lose fickle - optimisation in TclDeleteVars (used for runtime-created locals) + * generic/tclVar.c: [Bug 3037525]: Lose fickle optimisation in + TclDeleteVars (used for runtime-created locals) that caused crash. 2010-07-29 Jan Nijtmans - * compat/zlib/win32/README.txt Official build of zlib1.dll 1.2.5 is - * compat/zlib/win32/USAGE.txt finally available, so put it in. - * compat/zlib/win32/zlib1.dll + * compat/zlib/win32/README.txt: Official build of zlib1.dll 1.2.5 is + * compat/zlib/win32/USAGE.txt: finally available, so put it in. + * compat/zlib/win32/zlib1.dll: 2010-07-25 Donal K. Fellows diff --git a/generic/tclProc.c b/generic/tclProc.c index e4ca35b..64d3f13 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclProc.c,v 1.179 2010/03/05 14:34:04 dkf Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.180 2010/08/15 16:12:27 dkf Exp $ */ #include "tclInt.h" @@ -1106,13 +1106,15 @@ ProcWrongNumArgs( desiredObjs = TclStackAlloc(interp, (int) sizeof(Tcl_Obj *) * (numArgs+1)); + if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { + desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1); + } else { #ifdef AVOID_HACKS_FOR_ITCL - desiredObjs[0] = framePtr->objv[skip-1]; + desiredObjs[0] = framePtr->objv[skip-1]; #else - desiredObjs[0] = ((framePtr->isProcCallFrame & FRAME_IS_LAMBDA) - ? framePtr->objv[skip-1] - : Tcl_NewListObj(skip, framePtr->objv)); + desiredObjs[0] = Tcl_NewListObj(skip, framePtr->objv); #endif /* AVOID_HACKS_FOR_ITCL */ + } Tcl_IncrRefCount(desiredObjs[0]); defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt); @@ -1286,7 +1288,7 @@ InitResolvedLocals( codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS; /* - * Initialize the array of local variables stored in the call frame. Some + * Initialize the array of local variables stored in the call frame. Some * variables may have special resolution rules. In that case, we call * their "resolver" procs to get our hands on the variable, and we make * the compiled local a link to the real variable. diff --git a/tests/apply.test b/tests/apply.test index 809fdbe..9bcb50d 100644 --- a/tests/apply.test +++ b/tests/apply.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: apply.test,v 1.14 2009/10/29 17:21:48 dgp Exp $ +# RCS: @(#) $Id: apply.test,v 1.15 2010/08/15 16:12:27 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.2 @@ -24,54 +24,47 @@ if {[info commands ::apply] eq {}} { } testConstraint memory [llength [info commands memory]] - + # Tests for wrong number of arguments -test apply-1.1 {too few arguments} { - set res [catch apply msg] - list $res $msg -} {1 {wrong # args: should be "apply lambdaExpr ?arg ...?"}} +test apply-1.1 {too few arguments} -returnCodes error -body { + apply +} -result {wrong # args: should be "apply lambdaExpr ?arg ...?"} # Tests for malformed lambda -test apply-2.0 {malformed lambda} { +test apply-2.0 {malformed lambda} -returnCodes error -body { set lambda a - set res [catch {apply $lambda} msg] - list $res $msg -} {1 {can't interpret "a" as a lambda expression}} -test apply-2.1 {malformed lambda} { + apply $lambda +} -result {can't interpret "a" as a lambda expression} +test apply-2.1 {malformed lambda} -returnCodes error -body { set lambda [list a b c d] - set res [catch {apply $lambda} msg] - list $res $msg -} {1 {can't interpret "a b c d" as a lambda expression}} + apply $lambda +} -result {can't interpret "a b c d" as a lambda expression} test apply-2.2 {malformed lambda} { set lambda [list {{}} boo] - set res [catch {apply $lambda} msg] - list $res $msg $::errorInfo + list [catch {apply $lambda} msg] $msg $::errorInfo } {1 {argument with no name} {argument with no name (parsing lambda expression "{{}} boo") invoked from within "apply $lambda"}} test apply-2.3 {malformed lambda} { set lambda [list {{a b c}} boo] - set res [catch {apply $lambda} msg] - list $res $msg $::errorInfo + list [catch {apply $lambda} msg] $msg $::errorInfo } {1 {too many fields in argument specifier "a b c"} {too many fields in argument specifier "a b c" (parsing lambda expression "{{a b c}} boo") invoked from within "apply $lambda"}} test apply-2.4 {malformed lambda} { set lambda [list a(1) boo] - set res [catch {apply $lambda} msg] - list $res $msg $::errorInfo + list [catch {apply $lambda} msg] $msg $::errorInfo } {1 {formal parameter "a(1)" is an array element} {formal parameter "a(1)" is an array element (parsing lambda expression "a(1) boo") invoked from within "apply $lambda"}} test apply-2.5 {malformed lambda} { set lambda [list a::b boo] - set res [catch {apply $lambda} msg] - list $res $msg $::errorInfo + list [catch {apply $lambda} msg] $msg $::errorInfo } {1 {formal parameter "a::b" is not a simple name} {formal parameter "a::b" is not a simple name (parsing lambda expression "a::b boo") invoked from within @@ -100,29 +93,27 @@ test apply-3.4 {non-existing namespace} -body { apply $lambda x } -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found} -test apply-4.1 {error in arguments to lambda expression} { +test apply-4.1 {error in arguments to lambda expression} -body { set lambda [list x {set x 1}] - set res [catch {apply $lambda} msg] - list $res $msg -} {1 {wrong # args: should be "apply {x {set x 1}} x"}} -test apply-4.2 {error in arguments to lambda expression} { - set lambda [list x {set x 1}] - set res [catch {apply $lambda a b} msg] - list $res $msg -} {1 {wrong # args: should be "apply {x {set x 1}} x"}} -test apply-4.3 {error in arguments to lambda expression} { - set lambda [list x {set x 1}] - interp alias {} foo {} ::apply $lambda - set res [catch {foo a b} msg] - list $res $msg [rename foo {}] -} {1 {wrong # args: should be "foo x"} {}} -test apply-4.4 {error in arguments to lambda expression} { + apply $lambda +} -returnCodes error -result {wrong # args: should be "apply lambdaExpr x"} +test apply-4.2 {error in arguments to lambda expression} -body { set lambda [list x {set x 1}] - interp alias {} foo {} ::apply $lambda a - set res [catch {foo b} msg] - list $res $msg [rename foo {}] -} {1 {wrong # args: should be "foo"} {}} -test apply-4.5 {error in arguments to lambda expression} { + apply $lambda a b +} -returnCodes error -result {wrong # args: should be "apply lambdaExpr x"} +test apply-4.3 {error in arguments to lambda expression} -body { + interp alias {} foo {} ::apply [list x {set x 1}] + foo a b +} -cleanup { + rename foo {} +} -returnCodes error -result {wrong # args: should be "foo x"} +test apply-4.4 {error in arguments to lambda expression} -body { + interp alias {} foo {} ::apply [list x {set x 1}] a + foo b +} -cleanup { + rename foo {} +} -returnCodes error -result {wrong # args: should be "foo"} +test apply-4.5 {error in arguments to lambda expression} -body { set lambda [list x {set x 1}] namespace eval a { namespace ensemble create -command ::bar -map {id {::a::const foo}} @@ -138,9 +129,10 @@ test apply-4.5 {error in arguments to lambda expression} { } method ::bar boo x {return "[expr {$x*$x}] - $self"} } - set res [catch {bar boo} msg] - list $res $msg [namespace delete ::a] -} {1 {wrong # args: should be "bar boo x"} {}} + bar boo +} -cleanup { + namespace delete ::a +} -returnCodes error -result {wrong # args: should be "bar boo x"} test apply-5.1 {runtime error in lambda expression} { set lambda [list {} {error foo}] @@ -317,10 +309,15 @@ test apply-9.3 {leaking internal rep} -setup { } -result 0 # Tests for the avoidance of recompilation - + # cleanup namespace delete testApply ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: -- cgit v0.12