Index: modules/fileutil/ChangeLog ================================================================== --- modules/fileutil/ChangeLog +++ modules/fileutil/ChangeLog @@ -1,5 +1,18 @@ +2013-07-11 Andreas Kupries + + * fileutil.man: Ticket [8b317b4a63]: Added code to the 8.4+ + * fileutil.tcl: implementations of GLOBF and GLOBD to guard + * fileutil.test: ourselves against VFS packages mishandling the + * pkgIndex.tcl: -types option of [glob]. vfs::zip is an example. + This mishandling causes glob to return the same data for the two + calls with "-types x" and "-types {hidden x}", generating lists + with duplicate entries. We now generally de-duplicate the result + ourselves. Bumped the package version to 1.14.6. Thanks to + for the investigation identifying + this problem. + 2013-02-14 Andreas Kupries * decode.tcl: Bumped fileutil::decode to 0.2 to distinguish * pkgIndex.tcl: properly from the 0.1.xxx version which existed in AS/perforce before it moved to tcllib/fossil. That should have Index: modules/fileutil/fileutil.man ================================================================== --- modules/fileutil/fileutil.man +++ modules/fileutil/fileutil.man @@ -1,7 +1,8 @@ +[vset PACKAGE_VERSION 1.14.6] [comment {-*- tcl -*- doctools manpage}] -[manpage_begin fileutil n 1.14.5] +[manpage_begin fileutil n [vset PACKAGE_VERSION]] [keywords cat] [keywords {file utilities}] [keywords grep] [keywords {temp file}] [keywords test] @@ -9,11 +10,11 @@ [keywords type] [moddesc {file utilities}] [titledesc {Procedures implementing some file utilities}] [category {Programming tools}] [require Tcl 8] -[require fileutil [opt 1.14.5]] +[require fileutil [opt [vset PACKAGE_VERSION]]] [description] [para] This package provides implementations of standard unix utilities. Index: modules/fileutil/fileutil.tcl ================================================================== --- modules/fileutil/fileutil.tcl +++ modules/fileutil/fileutil.tcl @@ -11,11 +11,11 @@ # # RCS: @(#) $Id: fileutil.tcl,v 1.78 2010/06/17 04:46:19 andreas_kupries Exp $ package require Tcl 8.2 package require cmdline -package provide fileutil 1.14.5 +package provide fileutil 1.14.6 namespace eval ::fileutil { namespace export \ grep find findByPattern cat touch foreachLine \ jail stripPwd stripN stripPath tempdir tempfile \ @@ -227,23 +227,23 @@ !([file exists [file readlink $current]] && [file readable [file readlink $current]])} { return {} } - set res [concat \ + set res [lsort -unique [concat \ [glob -nocomplain -directory $current -types f -- *] \ - [glob -nocomplain -directory $current -types {hidden f} -- *]] + [glob -nocomplain -directory $current -types {hidden f} -- *]]] # Look for broken links (They are reported as neither file nor directory). - foreach l [concat \ + foreach l [lsort -unique [concat \ [glob -nocomplain -directory $current -types l -- *] \ - [glob -nocomplain -directory $current -types {hidden l} -- *] ] { + [glob -nocomplain -directory $current -types {hidden l} -- *]]] { if {[file isfile $l]} continue if {[file isdirectory $l]} continue lappend res $l } - return $res + return [lsort -unique $res] } proc ::fileutil::GLOBD {current} { if {![file readable $current]} { return {} @@ -252,13 +252,13 @@ !([file exists [file readlink $current]] && [file readable [file readlink $current]])} { return {} } - concat \ + lsort -unique [concat \ [glob -nocomplain -directory $current -types d -- *] \ - [glob -nocomplain -directory $current -types {hidden d} -- *] + [glob -nocomplain -directory $current -types {hidden d} -- *]] } } elseif {[package vsatisfies [package present Tcl] 8.4]} { # Tcl 8.4+. # (Ad 1) We have -directory, and -types, @@ -266,29 +266,29 @@ # (Ad 3) No bug to code around proc ::fileutil::ACCESS {args} {} proc ::fileutil::GLOBF {current} { - set res [concat \ - [glob -nocomplain -directory $current -types f -- *] \ - [glob -nocomplain -directory $current -types {hidden f} -- *]] + set res [lsort -unique [concat \ + [glob -nocomplain -directory $current -types f -- *] \ + [glob -nocomplain -directory $current -types {hidden f} -- *]]] # Look for broken links (They are reported as neither file nor directory). - foreach l [concat \ + foreach l [lsort -unique [concat \ [glob -nocomplain -directory $current -types l -- *] \ - [glob -nocomplain -directory $current -types {hidden l} -- *] ] { + [glob -nocomplain -directory $current -types {hidden l} -- *]]] { if {[file isfile $l]} continue if {[file isdirectory $l]} continue lappend res $l } - return $res + return [lsort -unique $res] } proc ::fileutil::GLOBD {current} { - concat \ + lsort -unique [concat \ [glob -nocomplain -directory $current -types d -- *] \ - [glob -nocomplain -directory $current -types {hidden d} -- *] + [glob -nocomplain -directory $current -types {hidden d} -- *]] } } elseif {[package vsatisfies [package present Tcl] 8.3]} { # 8.3. # (Ad 1) We have -directory, and -types, Index: modules/fileutil/fileutil.test ================================================================== --- modules/fileutil/fileutil.test +++ modules/fileutil/fileutil.test @@ -4,14 +4,18 @@ # Sourcing this file into Tcl runs the tests and generates output for errors. # No output means no errors were found. # # Copyright (c) 1998-2000 by Ajuba Solutions. # Copyright (c) 2001 by ActiveState Tool Corp. -# Copyright (c) 2005-2007 by Andreas Kupries +# Copyright (c) 2005-2013 by Andreas Kupries # All rights reserved. # # RCS: @(#) $Id: fileutil.test,v 1.56 2009/10/06 20:07:18 andreas_kupries Exp $ + +# TODO: Bug [8b317b4a63]: Create test cases for this bug. This +# requires the use of a custom VFS as the native filesystem does not +# contain the bug we are guarding ourselves against. # ------------------------------------------------------------------------- source [file join \ [file dirname [file dirname [file join [pwd] [info script]]]] \ Index: modules/fileutil/pkgIndex.tcl ================================================================== --- modules/fileutil/pkgIndex.tcl +++ modules/fileutil/pkgIndex.tcl @@ -1,7 +1,7 @@ if {![package vsatisfies [package provide Tcl] 8.2]} {return} -package ifneeded fileutil 1.14.5 [list source [file join $dir fileutil.tcl]] +package ifneeded fileutil 1.14.6 [list source [file join $dir fileutil.tcl]] if {![package vsatisfies [package provide Tcl] 8.3]} {return} package ifneeded fileutil::traverse 0.4.3 [list source [file join $dir traverse.tcl]] if {![package vsatisfies [package provide Tcl] 8.4]} {return}