* generic/tclFileName.c: Correct result from [glob */test] when *

        * tests/fileName.test:  matches something like ~foo.  [Bug 2837800]

3 files changed, 64 insertions, 4 deletions

diff --git a/ChangeLog b/ChangeLog
index e77c783..0b0209b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2009-08-17  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclFileName.c: Correct result from [glob */test] when *
+	* tests/fileName.test:	matches something like ~foo.  [Bug 2837800]
+
 2009-07-23  Joe Mistachkin  <joe@mistachkin.com>
 
 	* generic/tclNotify.c: Fix for [Bug 2820349].
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index c14893f..7d63018 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclFileName.c,v 1.40.2.17 2008/12/03 06:36:05 dgp Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.40.2.18 2009/08/17 20:00:01 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -2560,15 +2560,21 @@ TclDoGlob(interp, separators, headPtr, tail, types)
 					 head, tail, &dirOnly);
 	    *p = save;
 	    if (ret == TCL_OK) {
-		int resLength;
+		int resLength, repair = -1;
 		ret = Tcl_ListObjLength(interp, resultPtr, &resLength);
 		if (ret == TCL_OK) {
 		    int i;
 		    for (i =0; i< resLength; i++) {
 			Tcl_Obj *elt;
 			Tcl_DString ds;
-			Tcl_ListObjIndex(interp, resultPtr, i, &elt);
+			Tcl_ListObjIndex(NULL, resultPtr, i, &elt);
 			Tcl_DStringInit(&ds);
+			if (Tcl_GetString(elt)[0] == '~') {
+			    Tcl_Obj *paths = Tcl_GetObjResult(interp);
+
+			    Tcl_ListObjLength(NULL, paths, &repair);
+			    Tcl_DStringAppend(&ds, "./", 2);
+			}
 			Tcl_DStringAppend(&ds, Tcl_GetString(elt), -1);
 			if(tclPlatform == TCL_PLATFORM_MAC) {
 			    Tcl_DStringAppend(&ds, ":",1);
@@ -2580,6 +2586,24 @@ TclDoGlob(interp, separators, headPtr, tail, types)
 			if (ret != TCL_OK) {
 			    break;
 			}
+			if (repair >= 0) {
+			    Tcl_Obj *paths = Tcl_GetObjResult(interp);
+			    int end;
+
+			    Tcl_ListObjLength(NULL, paths, &end);
+			    while (repair < end) {
+				const char *bytes;
+				int numBytes;
+				Tcl_Obj *fixme, *newObj;
+				Tcl_ListObjIndex(NULL, paths, repair, &fixme);
+				bytes = Tcl_GetStringFromObj(fixme, &numBytes);
+				newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
+				Tcl_ListObjReplace(NULL, paths, repair, 1,
+					1, &newObj);
+				repair++;
+			    }
+			    repair = -1;
+			}
 		    }
 		}
 	    }
diff --git a/tests/fileName.test b/tests/fileName.test
index b197d2d..e482770 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: fileName.test,v 1.30.2.11 2009/03/27 19:14:36 dgp Exp $
+# RCS: @(#) $Id: fileName.test,v 1.30.2.12 2009/08/17 20:00:01 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -2064,6 +2064,37 @@ test fileName-20.4 {Bug 1750300} -setup {
     removeDirectory foo
 } -result 0
 
+test fileName-20.5 {Bug 2837800} -setup {
+    set dd [makeDirectory isolate]
+    set d [makeDirectory ./~foo $dd]
+    makeFile {} test $d
+    set savewd [pwd]
+    cd $dd
+} -body {
+    glob */test
+} -cleanup {
+    cd $savewd
+    removeFile test $d
+    removeDirectory ./~foo $dd
+    removeDirectory isolate
+} -result ~foo/test
+
+test fileName-20.6 {Bug 2837800} -setup {
+    # Recall that we have $env(HOME) set so that references
+    # to ~ point to [temporaryDirectory]
+    makeFile {} test ~
+    set dd [makeDirectory isolate]
+    set d [makeDirectory ./~ $dd]
+    set savewd [pwd]
+    cd $dd
+} -body {
+    glob -nocomplain */test
+} -cleanup {
+    cd $savewd
+    removeDirectory ./~ $dd
+    removeDirectory isolate
+    removeFile test ~
+} -result {}
 
 # cleanup
 catch {file delete -force C:/globTest}