summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog5
-rw-r--r--generic/tclFileName.c30
-rw-r--r--tests/fileName.test33
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}