summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog10
-rw-r--r--generic/tclFileName.c17
-rw-r--r--tests/fileName.test9
3 files changed, 32 insertions, 4 deletions
diff --git a/ChangeLog b/ChangeLog
index 4e9c664..33d332f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2003-04-29 Vince Darley <vincentdarley@users.sourceforge.net>
+
+ * generic/tclFileName.c: fix to bug reported privately by
+ Jeff where, for example, 'glob -path {[tcl]} *' gets confused
+ by the leading special character (which is escaped internally),
+ and instead lists files in '/'. Bug only occurs on Windows
+ where '\' is also a directory separator. (Bug has been around
+ at least since Tcl 8.3).
+ * tests/fileName.test: added test for the above bug.
+
2003-04-25 Don Porter <dgp@users.sourceforge.net>
* generic/tclBasic.c: Tcl_EvalObjv() failed to honor the
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 16bf9d0..4a9a0b6 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 2003/01/09 10:01:59 vincentdarley Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.40.2.1 2003/04/29 11:45:24 vincentdarley Exp $
*/
#include "tclInt.h"
@@ -2330,8 +2330,19 @@ TclDoGlob(interp, separators, headPtr, tail, types)
count = 0;
name = tail;
for (; *tail != '\0'; tail++) {
- if ((*tail == '\\') && (strchr(separators, tail[1]) != NULL)) {
- tail++;
+ if (*tail == '\\') {
+ /*
+ * If the first character is escaped, either we have a directory
+ * separator, or we have any other character. In the latter case
+ * the rest of tail is a pattern, and we must break from the loop.
+ * This is particularly important on Windows where '\' is both
+ * the escaping character and a directory separator.
+ */
+ if (strchr(separators, tail[1]) != NULL) {
+ tail++;
+ } else {
+ break;
+ }
} else if (strchr(separators, *tail) == NULL) {
break;
}
diff --git a/tests/fileName.test b/tests/fileName.test
index 01b67ef..6247fb9 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 2003/02/12 18:57:51 vincentdarley Exp $
+# RCS: @(#) $Id: fileName.test,v 1.30.2.1 2003/04/29 11:45:24 vincentdarley Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -1333,6 +1333,13 @@ test filename-11.21 {Tcl_GlobCmd} {
list [catch {lsort [glob -type d -path $globname *]} msg] $msg
} [list 0 [lsort [list $globname]]]
+test filename-11.21.1 {Tcl_GlobCmd} {
+ close [open {[tcl].testremains} w]
+ set res [list [catch {lsort [glob -path {[tcl]} *]} msg] $msg]
+ file delete -force {[tcl].testremains}
+ set res
+} [list 0 {{[tcl].testremains}}]
+
# Get rid of file/dir if it exists, since it will have
# been left behind by a previous failed run.
if {[file exists $horribleglobname]} {