* generic/tclVar.c (Tcl_ArrayObjCmd): Added support for regexp and

exact matching for [array names] command. [RFE: 3684].

* doc/array.n: Added documentation for [array names
-exact/-regexp/-glob] [RFE: 3684].

* tests/set-old.test: Added tests for [array names
-exact/-regexp/-glob] [RFE: 3684].

4 files changed, 103 insertions, 16 deletions

diff --git a/ChangeLog b/ChangeLog
index 241dc24..da4aa16 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,14 @@
+2000-05-31  Eric Melski  <ericm@scriptics.com>
+
+	* generic/tclVar.c (Tcl_ArrayObjCmd): Added support for regexp and
+	exact matching for [array names] command. [RFE: 3684].
+
+	* doc/array.n: Added documentation for [array names
+	-exact/-regexp/-glob] [RFE: 3684].
+
+	* tests/set-old.test: Added tests for [array names
+	-exact/-regexp/-glob] [RFE: 3684].
+
 2000-05-27  Jeff Hobbs  <hobbs@scriptics.com>
 
 	* tests/info.test:
diff --git a/doc/array.n b/doc/array.n
index 0f31196..ff610cd 100644
--- a/doc/array.n
+++ b/doc/array.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: array.n,v 1.6 2000/05/23 02:45:21 hobbs Exp $
+'\" RCS: @(#) $Id: array.n,v 1.7 2000/05/31 15:03:34 ericm Exp $
 '\" 
 .so man.macros
 .TH array n 8.3 Tcl "Tcl Built-In Commands"
@@ -63,15 +63,19 @@ match \fIpattern\fR (using the matching rules of
 If \fIarrayName\fR isn't the name of an array variable, or if
 the array contains no elements, then an empty list is returned.
 .TP
-\fBarray names \fIarrayName\fR ?\fIpattern\fR?
+\fBarray names \fIarrayName\fR ?\fImode\fR? ?\fIpattern\fR?
 Returns a list containing the names of all of the elements in
-the array that match \fIpattern\fR (using the matching
-rules of \fBstring match\fR).
+the array that match \fIpattern\fR.  \fIMode\fR may be one of
+\fB-exact\fR, \fB-glob\fR, or \fB-regexp\fR.  If specified, \fImode\fR
+designates which matching rules to use to match \fIpattern\fR against
+the names of the elements in the array.  If not specified, \fImode\fR
+defaults to \fB-glob\fR.  See the documentation for \fBstring match\fR
+for information on glob style matching, and the documentation for
+\fBregexp\fR for information on regexp matching.
 If \fIpattern\fR is omitted then the command returns all of
-the element names in the array.
-If there are no (matching) elements in the array, or if \fIarrayName\fR
-isn't the name of an array variable, then an empty string is
-returned.
+the element names in the array.  If there are no (matching) elements
+in the array, or if \fIarrayName\fR isn't the name of an array
+variable, then an empty string is returned.
 .TP
 \fBarray nextelement \fIarrayName searchId\fR
 Returns the name of the next element in \fIarrayName\fR, or
diff --git a/generic/tclVar.c b/generic/tclVar.c
index f9d5e32..8c279a0 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclVar.c,v 1.17 2000/05/08 21:25:31 ericm Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.18 2000/05/31 15:03:34 ericm Exp $
  */
 
 #include "tclInt.h"
@@ -3047,9 +3047,17 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
 	    char *pattern = NULL;
 	    char *name;
 	    Tcl_Obj *namePtr;
+	    int mode, matched = 0;
+	    static char *options[] = {
+		"-exact", "-glob", "-regexp", (char *) NULL
+	    };
+	    enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP };
+
+	    mode = OPT_GLOB;
 	    
-	    if ((objc != 3) && (objc != 4)) {
-  	        Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
+	    if ((objc < 3) && (objc > 5)) {
+  	        Tcl_WrongNumArgs(interp, 2, objv,
+			"arrayName ?mode? ?pattern?");
 		return TCL_ERROR;
 	    }
 	    if (notArray) {
@@ -3057,7 +3065,13 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
 	    }
 	    if (objc == 4) {
 	        pattern = Tcl_GetString(objv[3]);
-	    }
+	    } else if (objc == 5) {
+		pattern = Tcl_GetString(objv[4]);
+		if (Tcl_GetIndexFromObj(interp, objv[3], options, "option",
+			0, &mode) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    }       		
 	    for (hPtr = Tcl_FirstHashEntry(varPtr->value.tablePtr, &search);
 		 hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
 	        varPtr2 = (Var *) Tcl_GetHashValue(hPtr);
@@ -3065,8 +3079,25 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv)
 		    continue;
 		}
 		name = Tcl_GetHashKey(varPtr->value.tablePtr, hPtr);
-		if ((objc == 4) && !Tcl_StringMatch(name, pattern)) {
- 		    continue;	/* element name doesn't match pattern */
+		if (objc > 3) {
+		    switch ((enum options) mode) {
+			case OPT_EXACT:
+			    matched = (strcmp(name, pattern) == 0);
+			    break;
+			case OPT_GLOB:
+			    matched = Tcl_StringMatch(name, pattern);
+			    break;
+			case OPT_REGEXP:
+			    matched = Tcl_RegExpMatch(interp, name,
+				    pattern);
+			    if (matched < 0) {
+				return TCL_ERROR;
+			    }
+			    break;
+		    }
+		    if (matched == 0) {
+			continue;
+		    }
 		}
 		
 		namePtr = Tcl_NewStringObj(name, -1);
diff --git a/tests/set-old.test b/tests/set-old.test
index 888a6aa..d9f4084 100644
--- a/tests/set-old.test
+++ b/tests/set-old.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: set-old.test,v 1.9 2000/05/08 21:25:31 ericm Exp $
+# RCS: @(#) $Id: set-old.test,v 1.10 2000/05/31 15:03:35 ericm Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -388,7 +388,7 @@ test set-old-8.22 {array command, names option} {
     catch {unset a}
     set a(22) 3
     list [catch {array names a 4 5} msg] $msg
-} {1 {wrong # args: should be "array names arrayName ?pattern?"}}
+} {1 {bad option "4": must be -exact, -glob, or -regexp}}
 test set-old-8.19 {array command, names option} {
     catch {unset a}
     array names a
@@ -589,6 +589,47 @@ number of buckets with 8 entries: 0
 number of buckets with 9 entries: 0
 number of buckets with 10 or more entries: 0
 average search distance for entry: 1.7"
+test set-old-8.49 {array command, array names -exact on glob pattern} {
+    catch {unset a}
+    set a(1*2) 1
+    list [catch {array names a -exact 1*2} msg] $msg
+} {0 1*2}
+test set-old-8.48 {array command, array names -glob on glob pattern} {
+    catch {unset a}
+    set a(1*2) 1
+    set a(12) 1
+    set a(11) 1
+    list [catch {lsort [array names a -glob 1*2]} msg] $msg
+} {0 {1*2 12}}
+test set-old-8.49 {array command, array names -regexp on regexp pattern} {
+    catch {unset a}
+    set a(1*2) 1
+    set a(12) 1
+    set a(11) 1
+    list [catch {lsort [array names a -regexp ^1]} msg] $msg
+} {0 {1*2 11 12}}
+test set-old-8.50 {array command, array names -regexp} {
+    catch {unset a}
+    set a(-glob) 1
+    set a(-regexp) 1
+    set a(-exact) 1
+    list [catch {array names a -regexp} msg] $msg
+} {0 -regexp}
+test set-old-8.51 {array command, array names -exact} {
+    catch {unset a}
+    set a(-glob) 1
+    set a(-regexp) 1
+    set a(-exact) 1
+    list [catch {array names a -exact} msg] $msg
+} {0 -exact}
+test set-old-8.52 {array command, array names -glob} {
+    catch {unset a}
+    set a(-glob) 1
+    set a(-regexp) 1
+    set a(-exact) 1
+    list [catch {array names a -glob} msg] $msg
+} {0 -glob}
+
 
 test set-old-9.1 {ids for array enumeration} {
     catch {unset a}