From 2282409ca3414a57fa47500d32ce4dc879f4425a Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 31 Oct 2004 16:28:20 +0000
Subject: Make [info globals ::foo] work. [Bug 1057461]

---
 ChangeLog          |  6 ++++++
 generic/tclCmdIL.c | 10 +++++++++-
 tests/info.test    |  6 +++++-
 3 files changed, 20 insertions(+), 2 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 8546152..a9c4ab8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2004-10-31  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
+
+	* generic/tclCmdIL.c (InfoGlobalsCmd): 
+	* tests/info.test (info-8.4): Strip leading global-namespace
+	specifiers from the pattern argument. [Bug 1057461]
+
 2004-10-30  Kevin Kenny  <kennykb@acm.org>
 
 	* generic/clock.c: Replaced WIN32 macro with __WIN32__.
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 5c48f09..9d5c829 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.67 2004/10/25 01:06:49 msofer Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.68 2004/10/31 16:28:21 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1092,6 +1092,14 @@ InfoGlobalsCmd(dummy, interp, objc, objv)
 	pattern = NULL;
     } else if (objc == 3) {
 	pattern = TclGetString(objv[2]);
+	/*
+	 * Strip leading global-namespace qualifiers. [Bug 1057461]
+	 */
+	if (pattern[0] == ':' && pattern[1] == ':') {
+	    while (*pattern == ':') {
+		pattern++;
+	    }
+	}
     } else {
 	Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
 	return TCL_ERROR;
diff --git a/tests/info.test b/tests/info.test
index e95fca2..a5343fe 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: info.test,v 1.27 2004/05/19 20:15:31 dkf Exp $
+# RCS: @(#) $Id: info.test,v 1.28 2004/10/31 16:28:21 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -287,6 +287,10 @@ test info-8.2 {info globals option} {
 test info-8.3 {info globals option} {
     list [catch {info globals 1 2} msg] $msg
 } {1 {wrong # args: should be "info globals ?pattern?"}}
+test info-8.4 {info globals option: may have leading namespace qualifiers} {
+    set x 0
+    list [info globals x] [info globals :x] [info globals ::x] [info globals :::x] [info globals ::::x]
+} {x {} x x x}
 
 test info-9.1 {info level option} {
     info level
-- 
cgit v0.12