Tcl Source Code

Artifact 47b3287f2f0353f10f0205794a2df502695640b8:

Index: tests/fileName.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/fileName.test,v
retrieving revision 1.11
diff -u -r1.11 fileName.test
--- tests/fileName.test	2001/07/31 19:12:07	1.11
+++ tests/fileName.test	2001/08/22 17:55:05
@@ -1143,6 +1143,61 @@
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
 	[file join $globname y1.c] [file join $globname z1.c]]]]
+test filename-11.17.2 {Tcl_GlobCmd} {unixOnly notRoot} {
+    set dir [pwd]
+    set ret "error in test"
+    if {[catch {
+	cd $globname
+	exec ln -s a1 link
+	cd $dir
+	set ret [list [catch {
+	    lsort [glob -directory $globname -join * b1]
+	} msg] $msg]
+    }]} {
+	cd $dir
+    }
+    file delete [file join $globname link]
+    set ret
+} [list 0 [lsort [list [file join $globname a1 b1] \
+  [file join $globname link b1]]]]
+# Simpler version of the above test to illustrate a given bug.
+test filename-11.17.3 {Tcl_GlobCmd} {unixOnly notRoot} {
+    set dir [pwd]
+    set ret "error in test"
+    if {[catch {
+	cd $globname
+	exec ln -s a1 link
+	cd $dir
+	set ret [list [catch {
+	    lsort [glob -directory $globname -type d *]
+	} msg] $msg]
+    }]} {
+	cd $dir
+    }
+    file delete [file join $globname link]
+    set ret
+} [list 0 [lsort [list [file join $globname a1] \
+  [file join $globname a2] \
+  [file join $globname a3] \
+  [file join $globname link]]]]
+# Make sure the bugfix isn't too simple.  We don't want
+# to break 'glob -type l'.
+test filename-11.17.4 {Tcl_GlobCmd} {unixOnly notRoot} {
+    set dir [pwd]
+    set ret "error in test"
+    if {[catch {
+	cd $globname
+	exec ln -s a1 link
+	cd $dir
+	set ret [list [catch {
+	    lsort [glob -directory $globname -type l *]
+	} msg] $msg]
+    }]} {
+	cd $dir
+    }
+    file delete [file join $globname link]
+    set ret
+} [list 0 [list [file join $globname link]]]
 test filename-11.18 {Tcl_GlobCmd} {unixOnly} {
     list [catch {lsort [glob -path $globname/ *]} msg] $msg
 } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
Index: unix/tclUnixFile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixFile.c,v
retrieving revision 1.10
diff -u -r1.10 tclUnixFile.c
--- unix/tclUnixFile.c	2001/07/31 19:12:07	1.10
+++ unix/tclUnixFile.c	2001/08/22 17:55:05
@@ -315,10 +315,8 @@
 	}
 
 	/*
-	 * Now check to see if the file matches.  If there are more
-	 * characters to be processed, then ensure matching files are
-	 * directories before calling TclDoGlob. Otherwise, just add
-	 * the file to the result.
+	 * Now check to see if the file matches, according to both type
+	 * and pattern.  If so, add the file to the result.
 	 */
 
 	utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &ds);
@@ -329,17 +327,29 @@
 	    Tcl_DStringAppend(&dsOrig, utf, -1);
 	    fname = Tcl_DStringValue(&dsOrig);
 	    if (types != NULL) {
-		if (types->perm != 0) {
-		    struct stat buf;
+		struct stat buf;
 
+		if (types->perm != 0) {
 		    if (TclpStat(fname, &buf) != 0) {
-			panic("stat failed on known file");
+			/* 
+			 * Either the file has disappeared between the
+			 * 'readdir' call and the 'TclpStat' call, or
+			 * the file is a link to a file which doesn't
+			 * exist (which we could ascertain with
+			 * TclpLstat), or there is some other strange
+			 * problem.  In all these cases, we define this
+			 * to mean the file does not match any defined
+			 * permission, and therefore it is not 
+			 * added to the list of files to return.
+			 */
+			typeOk = 0;
 		    }
+		    
 		    /* 
 		     * readonly means that there are NO write permissions
 		     * (even for user), but execute is OK for anybody
 		     */
-		    if (
+		    if (typeOk && (
 			((types->perm & TCL_GLOB_PERM_RONLY) &&
 				(buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
 			((types->perm & TCL_GLOB_PERM_R) &&
@@ -348,17 +358,19 @@
 				(TclpAccess(fname, W_OK) != 0)) ||
 			((types->perm & TCL_GLOB_PERM_X) &&
 				(TclpAccess(fname, X_OK) != 0))
-			) {
+			)) {
 			typeOk = 0;
 		    }
 		}
 		if (typeOk && (types->type != 0)) {
-		    struct stat buf;
-		    /*
-		     * We must match at least one flag to be listed
-		     */
-		    typeOk = 0;
-		    if (TclpLstat(fname, &buf) >= 0) {
+		    if (types->perm == 0) {
+			/* We haven't yet done a stat on the file */
+			if (TclpStat(fname, &buf) != 0) {
+			    /* Posix error occurred */
+			    typeOk = 0;
+			}
+		    }
+		    if (typeOk) {
 			/*
 			 * In order bcdpfls as in 'find -t'
 			 */
@@ -373,19 +385,24 @@
 				    S_ISFIFO(buf.st_mode)) ||
 			    ((types->type & TCL_GLOB_TYPE_FILE) &&
 				    S_ISREG(buf.st_mode))
-#ifdef S_ISLNK
-			    || ((types->type & TCL_GLOB_TYPE_LINK) &&
-				    S_ISLNK(buf.st_mode))
-#endif
 #ifdef S_ISSOCK
 			    || ((types->type & TCL_GLOB_TYPE_SOCK) &&
 				    S_ISSOCK(buf.st_mode))
 #endif
 			    ) {
-			    typeOk = 1;
+			    /* Do nothing -- this file is ok */
+			} else {
+			    typeOk = 0;
+#ifdef S_ISLNK
+			    if (types->type & TCL_GLOB_TYPE_LINK) {
+				if (TclpLstat(fname, &buf) == 0) {
+				    if (S_ISLNK(buf.st_mode)) {
+				        typeOk = 1;
+				    }
+				}
+			    }
+#endif
 			}
-		    } else {
-			/* Posix error occurred */
 		    }
 		}
 	    }