From c00183e381bfa2fdf0f2d8537106526e0d2c67fb Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 29 Jul 2005 14:47:28 +0000
Subject: Take care with globals that have an entry in the var table but "don't
 exist"

---
 ChangeLog          |  5 +++++
 generic/tclCmdIL.c | 60 +++++++++++++++++++++++++++++++++++++-----------------
 tests/info.test    | 17 ++++++++++++++--
 3 files changed, 61 insertions(+), 21 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index dc7b4c3..5e7e252 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2005-07-29  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclCmdIL.c (InfoGlobalsCmd): Even in high-speed mode,
+	still have to take care with non-existant variables. [Bug 1247135]
+
 2005-07-28  Mo DeJong  <mdejong@users.sourceforge.net>
 
 	* win/README: Update link to msys_mingw8.zip.
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 21aebe3..558f206 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,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.78 2005/07/17 21:17:30 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.79 2005/07/29 14:47:46 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1245,8 +1245,11 @@ InfoGlobalsCmd(dummy, interp, objc, objv)
     if (pattern != NULL && TclMatchIsTrivial(pattern)) {
 	entryPtr = Tcl_FindHashEntry(&globalNsPtr->varTable, pattern);
 	if (entryPtr != NULL) {
-	    Tcl_ListObjAppendElement(interp, listPtr,
-		    Tcl_NewStringObj(pattern, -1));
+	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+	    if (!TclIsVarUndefined(varPtr)) {
+		Tcl_ListObjAppendElement(interp, listPtr,
+			Tcl_NewStringObj(pattern, -1));
+	    }
 	}
     } else {
 	for (entryPtr = Tcl_FirstHashEntry(&globalNsPtr->varTable, &search);
@@ -1585,26 +1588,45 @@ AppendLocals(interp, listPtr, pattern, includeLinks)
 	localPtr = localPtr->nextPtr;
     }
 
-    if (localVarTablePtr != NULL) {
-	if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
-	    if (Tcl_FindHashEntry(localVarTablePtr, pattern)) {
+    /*
+     * Do nothing if no local variables.
+     */
+
+    if (localVarTablePtr == NULL) {
+	return;
+    }
+
+    /*
+     * Check for the simple and fast case.
+     */
+
+    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
+	entryPtr = Tcl_FindHashEntry(localVarTablePtr, pattern);
+	if (entryPtr != NULL) {
+	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+	    if (!TclIsVarUndefined(varPtr)
+		    && (includeLinks || !TclIsVarLink(varPtr))) {
 		Tcl_ListObjAppendElement(interp, listPtr,
 			Tcl_NewStringObj(pattern,-1));
 	    }
-	    return;
 	}
-	for (entryPtr = Tcl_FirstHashEntry(localVarTablePtr, &search);
-		entryPtr != NULL;
-		entryPtr = Tcl_NextHashEntry(&search)) {
-	    varPtr = (Var *) Tcl_GetHashValue(entryPtr);
-	    if (!TclIsVarUndefined(varPtr)
-		    && (includeLinks || !TclIsVarLink(varPtr))) {
-		varName = Tcl_GetHashKey(localVarTablePtr, entryPtr);
-		if ((pattern == NULL)
-			|| Tcl_StringMatch(varName, pattern)) {
-		    Tcl_ListObjAppendElement(interp, listPtr,
-			    Tcl_NewStringObj(varName, -1));
-		}
+	return;
+    }
+
+    /*
+     * Scan over and process all local variables.
+     */
+
+    for (entryPtr = Tcl_FirstHashEntry(localVarTablePtr, &search);
+	    entryPtr != NULL;
+	    entryPtr = Tcl_NextHashEntry(&search)) {
+	varPtr = (Var *) Tcl_GetHashValue(entryPtr);
+	if (!TclIsVarUndefined(varPtr)
+		&& (includeLinks || !TclIsVarLink(varPtr))) {
+	    varName = Tcl_GetHashKey(localVarTablePtr, entryPtr);
+	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+		Tcl_ListObjAppendElement(interp, listPtr,
+			Tcl_NewStringObj(varName, -1));
 	    }
 	}
     }
diff --git a/tests/info.test b/tests/info.test
index 7295750..9014eee 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -11,10 +11,10 @@
 # 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.31 2005/05/30 00:04:48 dkf Exp $
+# RCS: @(#) $Id: info.test,v 1.32 2005/07/29 14:47:47 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
@@ -292,6 +292,19 @@ 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-8.5 {info globals option: only return existing global variables} {
+    -setup {
+	catch {unset ::NO_SUCH_VAR}
+	proc evalInProc script {eval $script}
+    }
+    -body {
+	evalInProc {global NO_SUCH_VAR; info globals NO_SUCH_VAR}
+    }
+    -cleanup {
+	rename evalInProc {}
+    }
+    -result {}
+}
 
 test info-9.1 {info level option} {
     info level
-- 
cgit v0.12