Implement TIP#341.

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