summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog14
-rw-r--r--doc/dict.n18
-rw-r--r--generic/tclDictObj.c72
-rw-r--r--tests/dict.test32
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 <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:
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<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