From 418c8071f2eaf8ed93cf80189e6b775369dba84b Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 10 Dec 2008 11:15:05 +0000 Subject: Implement TIP#341. --- ChangeLog | 14 +++++++--- doc/dict.n | 18 +++++++------ generic/tclDictObj.c | 72 ++++++++++++++++++++++++++++++++++------------------ tests/dict.test | 32 +++++++++++++---------- 4 files changed, 88 insertions(+), 48 deletions(-) diff --git a/ChangeLog b/ChangeLog index 13455f0..27d1f3c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,8 +1,16 @@ +2008-12-10 Donal K. Fellows + + TIP #341 IMPLEMENTATION + + * generic/tclDictObj.c (DictFilterCmd): Made key and value filtering + * tests/dict.test, doc/dict.n: accept arbitrary numbers of + glob arguments. + 2008-12-09 Jan Nijtmans - * generic/tclInt.decls: restore source and binary compatibility - for TIP #337 implementation. (when it's _that_ - simple, there is no excuse not to do it) :-) + * generic/tclInt.decls: Restore source and binary compatibility for + TIP #337 implementation. (When it is _that_ + simple, there is no excuse not to do it! :-)) * generic/tclIntDecls.h: make genstubs * generic/tclStubInit.c: diff --git a/doc/dict.n b/doc/dict.n index 308e367..4bbfedc 100644 --- a/doc/dict.n +++ b/doc/dict.n @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: dict.n,v 1.19 2008/10/15 10:43:37 dkf Exp $ +'\" RCS: @(#) $Id: dict.n,v 1.20 2008/12/10 11:15:05 dkf Exp $ '\" .so man.macros .TH dict n 8.5 Tcl "Tcl Built-In Commands" @@ -49,10 +49,11 @@ contains just those key/value pairs that match the specified filter type (which may be abbreviated.) Supported filter types are: .RS .TP -\fBdict filter \fIdictionaryValue \fBkey \fIglobPattern\fR -. -The key rule only matches those key/value pairs whose keys match the -given pattern (in the style of \fBstring match\fR.) +\fBdict filter \fIdictionaryValue \fBkey\fR ?\fIglobPattern ...\fR? +.VS 8.6 +The key rule only matches those key/value pairs whose keys match any +of the given patterns (in the style of \fBstring match\fR.) +.VE 8.6 .TP \fBdict filter \fIdictionaryValue \fBscript {\fIkeyVar valueVar\fB} \fIscript\fR . @@ -69,9 +70,10 @@ result. The key/value pairs are tested in the order in which the keys were inserted into the dictionary. .TP \fBdict filter \fIdictionaryValue \fBvalue \fIglobPattern\fR -. -The value rule only matches those key/value pairs whose values match -the given pattern (in the style of \fBstring match\fR.) +.VS 8.6 +The value rule only matches those key/value pairs whose values match any +of the given patterns (in the style of \fBstring match\fR.) +.VE 8.6 .RE .TP \fBdict for {\fIkeyVar valueVar\fB} \fIdictionaryValue body\fR diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index bcdc404..f895555 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDictObj.c,v 1.71 2008/12/02 19:40:41 dgp Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.72 2008/12/10 11:15:05 dkf Exp $ */ #include "tclInt.h" @@ -2736,11 +2736,6 @@ DictFilterCmd( switch ((enum FilterTypes) index) { case FILTER_KEYS: - if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, "dictionary key globPattern"); - return TCL_ERROR; - } - /* * Create a dictionary whose keys all match a certain pattern. */ @@ -2749,23 +2744,52 @@ DictFilterCmd( &keyObj, &valueObj, &done) != TCL_OK) { return TCL_ERROR; } - pattern = TclGetString(objv[3]); - resultObj = Tcl_NewDictObj(); - if (TclMatchIsTrivial(pattern)) { + if (objc == 3) { /* - * Must release the search lock here to prevent a memory leak - * since we are not exhausing the search. [Bug 1705778, leak K05] + * Nothing to match, so return nothing (== empty dictionary). */ Tcl_DictObjDone(&search); - Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj); - if (valueObj != NULL) { - Tcl_DictObjPut(interp, resultObj, objv[3], valueObj); + return TCL_OK; + } else if (objc == 4) { + pattern = TclGetString(objv[3]); + resultObj = Tcl_NewDictObj(); + if (TclMatchIsTrivial(pattern)) { + /* + * Must release the search lock here to prevent a memory leak + * since we are not exhausing the search. [Bug 1705778, leak + * K05] + */ + + Tcl_DictObjDone(&search); + Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj); + if (valueObj != NULL) { + Tcl_DictObjPut(interp, resultObj, objv[3], valueObj); + } + } else { + while (!done) { + if (Tcl_StringMatch(TclGetString(keyObj), pattern)) { + Tcl_DictObjPut(interp, resultObj, keyObj, valueObj); + } + Tcl_DictObjNext(&search, &keyObj, &valueObj, &done); + } } } else { + /* + * Can't optimize this match for trivial globbing: would disturb + * order. + */ + + resultObj = Tcl_NewDictObj(); while (!done) { - if (Tcl_StringMatch(TclGetString(keyObj), pattern)) { - Tcl_DictObjPut(interp, resultObj, keyObj, valueObj); + int i; + + for (i=3 ; i