From 2dd8bab9ea68a16f698de9db76e32964bb7e6c06 Mon Sep 17 00:00:00 2001
From: vincentdarley <vincentdarley>
Date: Tue, 9 Mar 2004 12:54:01 +0000
Subject: glob -path fix for near filesystem root

---
 ChangeLog             |  5 +++++
 generic/tclFileName.c |  9 ++++++++-
 tests/fileName.test   | 33 ++++++++++++++++++++++++++++++++-
 3 files changed, 45 insertions(+), 2 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index fa75fdd..d744970 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2004-03-08  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+	* generic/tclFileName.c:  Fix to 'glob -path' near the root
+	* tests/fileName.test:    of the filesystem. [Bug 910525]
+
 2004-03-08  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tclParse.c (TclParseInit):	Modified TclParseInit so
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 0590f40..e4c9fd8 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.47 2004/02/05 20:25:32 dgp Exp $
+ * RCS: @(#) $Id: tclFileName.c,v 1.48 2004/03/09 12:54:02 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -1745,6 +1745,13 @@ Tcl_GlobObjCmd(dummy, interp, objc, objv)
 		/* Have to split off the end */
 		Tcl_DStringAppend(&pref, last, first+pathlength-last);
 		pathOrDir = Tcl_NewStringObj(first, last-first-1);
+		/* 
+		 * We must ensure there's at least one path separator
+		 * in the prefix, even if it's just "/" or "C:/".
+		 */
+		if (strpbrk(Tcl_GetString(pathOrDir), "\\/") == NULL) {
+		    Tcl_AppendToObj(pathOrDir, last-1, 1); 
+		}
 	    }
 	    /* Need to quote 'prefix' */
 	    Tcl_DStringInit(&prefix);
diff --git a/tests/fileName.test b/tests/fileName.test
index fbe016c..181be16 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.36 2004/02/28 15:46:29 vincentdarley Exp $
+# RCS: @(#) $Id: fileName.test,v 1.37 2004/03/09 12:54:02 vincentdarley Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -1668,6 +1668,37 @@ test filename-12.5 {simple globbing} {
 test filename-12.6 {simple globbing} {
     list [catch {glob globTest\\/\\x1.c} msg] $msg
 } "0 $globPreResult$x1"
+test filename-12.7 {globbing at filesystem root} {unixOnly} {
+    set res1 [glob -nocomplain /*]
+    set res2 [glob -path / *]
+    set equal [string equal $res1 $res2]
+    if {!$equal} {
+	lappend equal "not equal" $res1 $res2
+    }
+    set equal
+} {1}
+test filename-12.8 {globbing at filesystem root} {unixOnly} {
+    set dir [lindex [glob -type d /*] 0]
+    set first [string range $dir 0 1]
+    set res1 [glob -nocomplain ${first}*]
+    set res2 [glob -path $first *]
+    set equal [string equal $res1 $res2]
+    if {!$equal} {
+	lappend equal "not equal" $res1 $res2
+    }
+    set equal
+} {1}
+test filename-12.9 {globbing at filesystem root} {winOnly} {
+    set dir [lindex [glob -type d [lindex [file volumes] 0]*] 0]
+    set first [string range $dir 0 3]
+    set res1 [glob -nocomplain ${first}*]
+    set res2 [glob -path $first *]
+    set equal [string equal $res1 $res2]
+    if {!$equal} {
+	lappend equal "not equal" $res1 $res2
+    }
+    set equal
+} {1}
 
 test filename-13.1 {globbing with brace substitution} {
     list [catch {glob globTest/\{\}} msg] $msg
-- 
cgit v0.12