From 96992f6e123f5c09d442436c567af19005d09291 Mon Sep 17 00:00:00 2001 From: msofer Date: Tue, 4 Sep 2001 22:45:51 +0000 Subject: made [proc] check that formal args have simple names [Bug: 458548] FossilOrigin-Name: 1f598f46700ec95a1e3adfe43a62f49a0323d577 --- ChangeLog | 7 ++++++- generic/tclProc.c | 10 +++++++++- tests/proc.test | 7 ++++++- 3 files changed, 21 insertions(+), 3 deletions(-) diff --git a/ChangeLog b/ChangeLog index 1dc230d..4a4a910 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2001-09-04 Miguel Sofer + + * generic/tclProc.c: made [proc] check that formal args have + simple names [Bug: 458548] + 2001-09-04 Vince Darley Minor bug fixes in filesystem, plus small vfs changes as a @@ -42,7 +47,7 @@ 2001-09-04 Miguel Sofer - * generic/tclCompile.c: fixed incorrect opreands for INST_LIST + * generic/tclCompile.c: fixed incorrect operands for INST_LIST [Bug: 458241] (David Cuthbert, dacut@users.sourceforge.net) 2001-09-03 Jeff Hobbs diff --git a/generic/tclProc.c b/generic/tclProc.c index 4ae489d..df0f1e9 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.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: tclProc.c,v 1.25 2001/04/27 22:11:51 kennykb Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.26 2001/09/04 22:45:52 msofer Exp $ */ #include "tclInt.h" @@ -336,6 +336,14 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr) ckfree((char *) fieldValues); goto procError; } + } else if ((*p == ':') && (*(p+1) == ':')) { + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "procedure \"", procName, + "\" has formal parameter \"", fieldValues[0], + "\" that is not a simple name", + (char *) NULL); + ckfree((char *) fieldValues); + goto procError; } p++; } diff --git a/tests/proc.test b/tests/proc.test index a96373a..8f21817 100644 --- a/tests/proc.test +++ b/tests/proc.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: proc.test,v 1.8 2000/05/03 00:14:36 hobbs Exp $ +# RCS: @(#) $Id: proc.test,v 1.9 2001/09/04 22:45:52 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -96,6 +96,11 @@ test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array e puts "$z=z, $a(1)=$a(1)" }} msg] $msg } {1 {procedure "p" has formal parameter "a(1)" that is an array element}} +test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} { + catch {rename p ""} + list [catch {proc p {b:a b::a} { + }} msg] $msg +} {1 {procedure "p" has formal parameter "b::a" that is not a simple name}} test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} { catch {eval namespace delete [namespace children :: test_ns_*]} -- cgit v0.12