diff options
| -rw-r--r-- | ChangeLog | 8 | ||||
| -rw-r--r-- | library/tcltest/pkgIndex.tcl | 2 | ||||
| -rw-r--r-- | library/tcltest/tcltest.tcl | 31 | ||||
| -rwxr-xr-x | tests/tcltest.test | 19 |
4 files changed, 39 insertions, 21 deletions
@@ -1,3 +1,11 @@ +2005-02-24 Don Porter <dgp@users.sourceforge.net> + + * library/tcltest/tcltest.tcl: Better use of [glob -types] to avoid + * tests/tcltest.test: failed attempts to [source] a directory, and + similar matters. Thanks to "mpettigr". [Bug 1119798] + + * library/tcltest/pkgIndex.tcl: Bump to tcltest 2.2.8 + 2005-02-23 Donal K. Fellows <donal.k.fellows@man.ac.uk> * doc/CrtChannel.3 (THREADACTIONPROC): Formatting fix. [Bug 1149605] diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index fe594b6..1aa4a46 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -9,4 +9,4 @@ # full path name of this file's directory. if {![package vsatisfies [package provide Tcl] 8.3]} {return} -package ifneeded tcltest 2.2.7 [list source [file join $dir tcltest.tcl]] +package ifneeded tcltest 2.2.8 [list source [file join $dir tcltest.tcl]] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index eac8278..4e42932 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -16,7 +16,7 @@ # Contributions from Don Porter, NIST, 2002. (not subject to US copyright) # All rights reserved. # -# RCS: @(#) $Id: tcltest.tcl,v 1.78.2.12 2004/11/02 19:03:07 dgp Exp $ +# RCS: @(#) $Id: tcltest.tcl,v 1.78.2.13 2005/02/24 18:03:36 dgp Exp $ package require Tcl 8.3 ;# uses [glob -directory] namespace eval tcltest { @@ -24,7 +24,7 @@ namespace eval tcltest { # When the version number changes, be sure to update the pkgIndex.tcl file, # and the install directory in the Makefiles. When the minor version # changes (new feature) be sure to update the man page as well. - variable Version 2.2.7 + variable Version 2.2.8 # Compatibility support for dumb variables defined in tcltest 1 # Do not use these. Call [package provide Tcl] and [info patchlevel] @@ -2569,14 +2569,16 @@ proc tcltest::GetMatchingFiles { args } { set matchFileList [list] foreach match [matchFiles] { set matchFileList [concat $matchFileList \ - [glob -directory $directory -nocomplain -- $match]] + [glob -directory $directory -types {b c f p s} \ + -nocomplain -- $match]] } # List files in $directory that match patterns to skip. set skipFileList [list] foreach skip [skipFiles] { set skipFileList [concat $skipFileList \ - [glob -directory $directory -nocomplain -- $skip]] + [glob -directory $directory -types {b c f p s} \ + -nocomplain -- $skip]] } # Add to result list all files in match list and not in skip list @@ -2618,25 +2620,20 @@ proc tcltest::GetMatchingDirectories {rootdir} { # comes up to avoid infinite loops. set skipDirs [list $rootdir] foreach pattern [skipDirectories] { - foreach path [glob -directory $rootdir -nocomplain -- $pattern] { - if {[file isdirectory $path]} { - lappend skipDirs $path - } - } + set skipDirs [concat $skipDirs [glob -directory $rootdir -types d \ + -nocomplain -- $pattern]] } # Now step through the matching directories, prune out the skipped ones # as you go. set matchDirs [list] foreach pattern [matchDirectories] { - foreach path [glob -directory $rootdir -nocomplain -- $pattern] { - if {[file isdirectory $path]} { - if {[lsearch -exact $skipDirs $path] == -1} { - set matchDirs [concat $matchDirs \ - [GetMatchingDirectories $path]] - if {[file exists [file join $path all.tcl]]} { - lappend matchDirs $path - } + foreach path [glob -directory $rootdir -types d -nocomplain -- \ + $pattern] { + if {[lsearch -exact $skipDirs $path] == -1} { + set matchDirs [concat $matchDirs [GetMatchingDirectories $path]] + if {[file exists [file join $path all.tcl]]} { + lappend matchDirs $path } } } diff --git a/tests/tcltest.test b/tests/tcltest.test index 99efabf..5397e1e 100755 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -6,7 +6,7 @@ # Copyright (c) 2000 by Ajuba Solutions # All rights reserved. # -# RCS: @(#) $Id: tcltest.test,v 1.37.2.8 2004/11/25 11:31:32 rmax Exp $ +# RCS: @(#) $Id: tcltest.test,v 1.37.2.9 2005/02/24 18:03:37 dgp Exp $ # Note that there are several places where the value of # tcltest::currentFailure is stored/reset in the -setup/-cleanup @@ -703,7 +703,7 @@ test tcltest-9.1 {-file a*.tcl} -constraints {unixOrPc} -setup { set old [testsDirectory] testsDirectory [file dirname [info script]] } -body { - slave msg [file join [testsDirectory] all.tcl] -file a*.test + slave msg [file join [testsDirectory] all.tcl] -file as*.test set msg } -cleanup { testsDirectory $old @@ -714,7 +714,7 @@ test tcltest-9.2 {-file a*.tcl} -constraints {unixOrPc} -setup { testsDirectory [file dirname [info script]] } -body { slave msg [file join [testsDirectory] all.tcl] \ - -file a*.test -notfile assocd* + -file as*.test -notfile assocd* regexp {assocd\.test} $msg } -cleanup { testsDirectory $old @@ -746,6 +746,19 @@ test tcltest-9.4 {skipFiles} { -result {foo bar} } +test tcltest-9.5 {GetMatchingFiles: Bug 1119798} -setup { + file copy [file join [file dirname [info script]] all.tcl] [temporaryDirectory] + makeDirectory foo + makeFile {} fee +} -body { + slave msg [file join [temporaryDirectory] all.tcl] -file f* + regexp {exiting with errors:} $msg +} -cleanup { + removeFile fee + removeDirectory foo + file delete [file join [temporaryDirectory] all.tcl] +} -result 0 + # -preservecore, [preserveCore] set mc [makeFile { package require tcltest |