diff options
| -rw-r--r-- | ChangeLog | 14 | ||||
| -rw-r--r-- | doc/dict.n | 18 | ||||
| -rw-r--r-- | generic/tclDictObj.c | 72 | ||||
| -rw-r--r-- | tests/dict.test | 32 |
4 files changed, 88 insertions, 48 deletions
@@ -1,8 +1,16 @@ +2008-12-10 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + 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 <nijtmans@users.sf.net> - * 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: @@ -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<objc ; i++) { + pattern = TclGetString(objv[i]); + if (Tcl_StringMatch(TclGetString(keyObj), pattern)) { + Tcl_DictObjPut(interp, resultObj, keyObj, valueObj); + break; /* stop inner loop */ + } } Tcl_DictObjNext(&search, &keyObj, &valueObj, &done); } @@ -2774,11 +2798,6 @@ DictFilterCmd( return TCL_OK; case FILTER_VALUES: - if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, "dictionary value globPattern"); - return TCL_ERROR; - } - /* * Create a dictionary whose values all match a certain pattern. */ @@ -2787,11 +2806,16 @@ DictFilterCmd( &keyObj, &valueObj, &done) != TCL_OK) { return TCL_ERROR; } - pattern = TclGetString(objv[3]); resultObj = Tcl_NewDictObj(); while (!done) { - if (Tcl_StringMatch(TclGetString(valueObj), pattern)) { - Tcl_DictObjPut(interp, resultObj, keyObj, valueObj); + int i; + + for (i=3 ; i<objc ; i++) { + pattern = TclGetString(objv[i]); + if (Tcl_StringMatch(TclGetString(valueObj), pattern)) { + Tcl_DictObjPut(interp, resultObj, keyObj, valueObj); + break; /* stop inner loop */ + } } Tcl_DictObjNext(&search, &keyObj, &valueObj, &done); } diff --git a/tests/dict.test b/tests/dict.test index e8fe560..c631cdc 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -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: dict.test,v 1.30 2008/07/19 22:50:39 nijtmans Exp $ +# RCS: @(#) $Id: dict.test,v 1.31 2008/12/10 11:15:05 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -678,12 +678,15 @@ test dict-17.3 {dict filter command: key} { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} getOrder [dict filter $dictVar key ???] bar foo } {bar foo foo bar 2} -test dict-17.4 {dict filter command: key} -returnCodes error -body { - dict filter {} key -} -result {wrong # args: should be "dict filter dictionary key globPattern"} -test dict-17.5 {dict filter command: key} -returnCodes error -body { - dict filter {} key a a -} -result {wrong # args: should be "dict filter dictionary key globPattern"} +test dict-17.4 {dict filter command: key - no patterns} { + dict filter {a b c d} key +} {} +test dict-17.4.1 {dict filter command: key - many patterns} { + dict filter {a1 a a2 b b1 c b2 d foo bar bar foo} key a? b? +} {a1 a a2 b b1 c b2 d} +test dict-17.5 {dict filter command: key - bad dict} -returnCodes error -body { + dict filter {a b c} key +} -result {missing value to go with key} test dict-17.6 {dict filter command: value} { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} dict filter $dictVar value c @@ -696,12 +699,15 @@ test dict-17.8 {dict filter command: value} { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} getOrder [dict filter $dictVar value ???] bar foo } {bar foo foo bar 2} -test dict-17.9 {dict filter command: value} -returnCodes error -body { - dict filter {} value -} -result {wrong # args: should be "dict filter dictionary value globPattern"} -test dict-17.10 {dict filter command: value} -returnCodes error -body { - dict filter {} value a a -} -result {wrong # args: should be "dict filter dictionary value globPattern"} +test dict-17.9 {dict filter command: value - no patterns} { + dict filter {a b c d} value +} {} +test dict-17.9.1 {dict filter command: value - many patterns} { + dict filter {a a1 b a2 c b1 foo bar bar foo d b2} value a? b? +} {a a1 b a2 c b1 d b2} +test dict-17.10 {dict filter command: value - bad dict} -body { + dict filter {a b c} value a +} -returnCodes error -result {missing value to go with key} test dict-17.11 {dict filter command: script} { set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo} set n 0 |