diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | tests/fCmd.test | 12 | ||||
| -rw-r--r-- | tests/fileName.test | 43 | ||||
| -rw-r--r-- | unix/tclUnixFile.c | 16 |
4 files changed, 68 insertions, 9 deletions
@@ -1,3 +1,9 @@ +2003-02-10 Vince Darley <vincentdarley@users.sourceforge.net> + + * tests/fileName.test: + * unix/tclUnixFile.c: fix for [Bug 685445] when using 'glob -l' + on broken symbolic links. Added two new tests for this bug. + 2003-02-11 Kevin Kenny <kennykb@users.sourceforge.net> * tests/http.test: Corrected a problem where http-4.14 would fail diff --git a/tests/fCmd.test b/tests/fCmd.test index 08ff618..e3bec24 100644 --- a/tests/fCmd.test +++ b/tests/fCmd.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: fCmd.test,v 1.25 2002/10/04 08:25:14 dkf Exp $ +# RCS: @(#) $Id: fCmd.test,v 1.26 2003/02/12 19:18:13 vincentdarley Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -69,11 +69,11 @@ proc openup {path} { } proc cleanup {args} { - if {$::tcl_platform(platform) == "macintosh"} { - set wd [list :] - } else { - set wd [list .] - } + if {$::tcl_platform(platform) == "macintosh"} { + set wd [list :] + } else { + set wd [list .] + } foreach p [concat $wd $args] { set x "" catch { diff --git a/tests/fileName.test b/tests/fileName.test index 15bef4e..01b67ef 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.29 2003/02/07 15:29:31 vincentdarley Exp $ +# RCS: @(#) $Id: fileName.test,v 1.30 2003/02/12 18:57:51 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1185,6 +1185,11 @@ if {[string equal $tcl_platform(platform) "windows"]} { } else { tcltest::testConstraint linkDirectory 1 } +if {[string equal $tcl_platform(platform) "windows"]} { + tcltest::testConstraint symbolicLinkFile 0 +} else { + tcltest::testConstraint symbolicLinkFile 1 +} test filename-11.17.2 {Tcl_GlobCmd} {notRoot linkDirectory} { set dir [pwd] set ret "error in test" @@ -1247,6 +1252,42 @@ test filename-11.17.6 {Tcl_GlobCmd} { list [catch {lsort [glob -directory $globname -tails *.c *.c]} msg] $msg } [list 0 [lsort [concat [list "weird name.c" x,z1.c x1.c y1.c z1.c] \ [list "weird name.c" x,z1.c x1.c y1.c z1.c]]]] +test filename-11.17.7 {Tcl_GlobCmd: broken link and glob -l} {linkDirectory} { + set dir [pwd] + set ret "error in test" + if {[catch { + cd $globname + file mkdir nonexistent + file link -symbolic link nonexistent + file delete nonexistent + cd $dir + set ret [list [catch { + lsort [glob -nocomplain -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.17.8 {Tcl_GlobCmd: broken link and glob -l} {symbolicLinkFile} { + set dir [pwd] + set ret "error in test" + if {[catch { + cd $globname + close [open "nonexistent" w] + file link -symbolic link nonexistent + file delete nonexistent + cd $dir + set ret [list [catch { + lsort [glob -nocomplain -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]\ diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 4e89ee1..3e74d16 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUnixFile.c,v 1.31 2003/02/11 09:42:02 hobbs Exp $ + * RCS: @(#) $Id: tclUnixFile.c,v 1.32 2003/02/12 18:57:52 vincentdarley Exp $ */ #include "tclInt.h" @@ -386,7 +386,19 @@ NativeMatchType( if (types->perm == 0) { /* We haven't yet done a stat on the file */ if (TclOSstat(nativeEntry, &buf) != 0) { - /* Posix error occurred */ + /* + * Posix error occurred. The only ok + * case is if this is a link to a nonexistent + * file, and the user did 'glob -l'. So + * we check that here: + */ + if (types->type & TCL_GLOB_TYPE_LINK) { + if (TclOSlstat(nativeEntry, &buf) == 0) { + if (S_ISLNK(buf.st_mode)) { + return 1; + } + } + } return 0; } } |