From 989af4406792dd86a36e3b8b8fb8c6800a2d3030 Mon Sep 17 00:00:00 2001 From: Steve Bennett Date: Fri, 28 Nov 2014 13:21:04 +1000 Subject: glob: add additional tests Import some additional tests from the Tcl test suite. Add more Tcl compatibility to tcltest.tcl Signed-off-by: Steve Bennett --- tests/glob2.test | 344 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 344 insertions(+) create mode 100644 tests/glob2.test (limited to 'tests/glob2.test') diff --git a/tests/glob2.test b/tests/glob2.test new file mode 100644 index 0000000..e6e4a4b --- /dev/null +++ b/tests/glob2.test @@ -0,0 +1,344 @@ +# This file tests the filename manipulation routines. +# +# This file contains a collection of tests for one or more of the Tcl built-in +# commands. Sourcing this file into Tcl runs the tests and generates output +# for errors. No output means no errors were found. +# +# Copyright (c) 1995-1996 Sun Microsystems, Inc. +# Copyright (c) 1999 by Scriptics Corporation. +# +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. + +source [file dirname [info script]]/testing.tcl + +needs cmd file +needs cmd glob + +testConstraint win [expr {$tcl_platform(platform) eq "windows"}] +testConstraint unix [expr {$tcl_platform(platform) eq "unix"}] +testConstraint unixOrPc 1 + +proc touch filename {catch {close [open $filename w]}} +global env + +test filename-4.19 {Tcl_SplitPath} -setup { + set oldDir [pwd] + cd [temporaryDirectory] +} -body { + file mkdir tildetmp + set nastydir [file join tildetmp ./~tilde] + file mkdir $nastydir + set norm [file normalize $nastydir] + cd tildetmp + cd ./~tilde + glob -nocomplain * + set idx [string first tildetmp $norm] + set norm [string range $norm $idx end] + # fix path away so all platforms are the same + regsub {(.*):$} $norm {\1} norm + regsub -all ":" $norm "/" norm + # make sure we can delete the directory we created + cd $oldDir + file delete -force $nastydir + return $norm +} -cleanup { + cd $oldDir + catch {file delete -force [file join [temporaryDirectory] tildetmp]} +} -result {tildetmp/~tilde} + +test filename-11.2 {Tcl_GlobCmd} -returnCodes error -body { + glob -gorp +} -match glob -result {bad option "-gorp": must be *} +test filename-11.3 {Tcl_GlobCmd} -constraints tcl -body { + glob -nocomplai +} -result {} +test filename-11.4 {Tcl_GlobCmd} -constraints tcl -body { + glob -nocomplain +} -result {} +test filename-11.5 {Tcl_GlobCmd} -constraints tcl -returnCodes error -body { + glob -nocomplain * ~xyqrszzz +} -result {user "xyqrszzz" doesn't exist} +test filename-11.6 {Tcl_GlobCmd} -constraints tcl -returnCodes error -body { + glob ~xyqrszzz +} -result {user "xyqrszzz" doesn't exist} +test filename-11.7 {Tcl_GlobCmd} -returnCodes error -body { + glob -- -nocomplain +} -match glob -result {no files matched glob pattern "-nocomplain"} +test filename-11.8 {Tcl_GlobCmd} -body { + glob -nocomplain -- -nocomplain +} -result {} +test filename-11.13 {Tcl_GlobCmd} tcl { + file join [lindex [glob ~] 0] +} [file join $env(HOME)] +set oldpwd [pwd] +set oldhome $env(HOME) +cd [temporaryDirectory] +set env(HOME) [pwd] +file delete -force globTest +file mkdir globTest/a1/b1 +file mkdir globTest/a1/b2 +file mkdir globTest/a2/b3 +file mkdir globTest/a3 +touch globTest/x1.c +touch globTest/y1.c +touch globTest/z1.c +touch "globTest/weird name.c" +touch globTest/a1/b1/x2.c +touch globTest/a1/b2/y2.c +touch globTest/.1 +touch globTest/x,z1.c +test filename-11.14 {Tcl_GlobCmd} tcl { + glob ~/globTest +} [list [file join $env(HOME) globTest]] +test filename-11.15 {Tcl_GlobCmd} tcl { + glob ~\\/globTest +} [list [file join $env(HOME) globTest]] +test filename-11.16 {Tcl_GlobCmd} { + glob globTest +} {globTest} +set globname "globTest" +set horribleglobname "glob\[\{Test" +test filename-11.17 {Tcl_GlobCmd} {unix} { + lsort [glob -directory $globname *] +} [lsort [list [file join $globname a1] [file join $globname a2]\ + [file join $globname a3]\ + [file join $globname "weird name.c"]\ + [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.1 {Tcl_GlobCmd} {win} { + lsort [glob -directory $globname *] +} [lsort [list [file join $globname a1] [file join $globname a2]\ + [file join $globname .1]\ + [file join $globname a3]\ + [file join $globname "weird name.c"]\ + [file join $globname x,z1.c]\ + [file join $globname x1.c]\ + [file join $globname y1.c] [file join $globname z1.c]]] +# Get rid of file/dir if it exists, since it will have been left behind by a +# previous failed run. +if {[file exists $horribleglobname]} { + file delete -force $horribleglobname +} +file rename globTest $horribleglobname +set globname $horribleglobname +test filename-11.22 {Tcl_GlobCmd} {unix} { + lsort [glob -dir $globname *] +} [lsort [list [file join $globname a1] [file join $globname a2]\ + [file join $globname a3]\ + [file join $globname "weird name.c"]\ + [file join $globname x,z1.c]\ + [file join $globname x1.c]\ + [file join $globname y1.c] [file join $globname z1.c]]] +test filename-11.22.1 {Tcl_GlobCmd} {win} { + lsort [glob -dir $globname *] +} [lsort [list [file join $globname a1] [file join $globname a2]\ + [file join $globname .1]\ + [file join $globname a3]\ + [file join $globname "weird name.c"]\ + [file join $globname x,z1.c]\ + [file join $globname x1.c]\ + [file join $globname y1.c] [file join $globname z1.c]]] + +file rename $horribleglobname globTest +set globname globTest +unset horribleglobname + +test filename-12.1 {simple globbing} {unixOrPc tcl} { + glob {} +} {.} +test filename-12.3 {simple globbing} { + glob -nocomplain \{a1,a2\} +} {} +set globPreResult globTest/ +set x1 x1.c +set y1 y1.c +test filename-12.4 {simple globbing} {unixOrPc} { + lsort [glob globTest/x1.c globTest/y1.c globTest/foo] +} "$globPreResult$x1 $globPreResult$y1" + +test filename-13.7 {globbing with brace substitution} { + glob globTest/\{x\}1.c +} "$globPreResult$x1" + +test filename-13.9 {globbing with brace substitution} { + lsort [glob globTest/\{x,y\}1.c] +} [list $globPreResult$x1 $globPreResult$y1] +test filename-13.10 {globbing with brace substitution} { + lsort [glob globTest/\{x,,y\}1.c] +} [list $globPreResult$x1 $globPreResult$y1] +test filename-13.11 {globbing with brace substitution} {unixOrPc} { + lsort [glob globTest/\{x,x\\,z,z\}1.c] +} [lsort {globTest/x1.c globTest/x,z1.c globTest/z1.c}] +test filename-13.13 {globbing with brace substitution} { + lsort [glob globTest/{a,b,x,y}1.c] +} [list $globPreResult$x1 $globPreResult$y1] +test filename-13.14 {globbing with brace substitution} {unixOrPc} { + lsort [glob {globTest/{x1,y2,weird name}.c}] +} {{globTest/weird name.c} globTest/x1.c} +test filename-13.16 {globbing with brace substitution} {unixOrPc} { + lsort [glob globTest/{x1.c,a1/*}] +} {globTest/a1/b1 globTest/a1/b2 globTest/x1.c} +test filename-13.18 {globbing with brace substitution} {unixOrPc} { + lsort [glob globTest/{x1.c,{a},a1/*}] +} {globTest/a1/b1 globTest/a1/b2 globTest/x1.c} +test filename-13.20 {globbing with brace substitution} {unixOrPc} { + lsort [glob globTest/{a,x}1/*/{x,y}*] +} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c} + +test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} { + lsort [glob glo*/*.c] +} {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} +test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} { + lsort [glob globTest/?1.c] +} {globTest/x1.c globTest/y1.c globTest/z1.c} +test filename-14.5 {asterisks, question marks, and brackets} -setup { + # The current directory could be anywhere; do this to stop spurious + # matches + file mkdir globTestContext + file rename globTest [file join globTestContext globTest] + set savepwd [pwd] + cd globTestContext +} -constraints {unixOrPc} -body { + lsort [glob */*/*/*.c] +} -cleanup { + # Reset to where we were + cd $savepwd + file rename [file join globTestContext globTest] globTest + file delete globTestContext +} -result {globTest/a1/b1/x2.c globTest/a1/b2/y2.c} +test filename-14.7 {asterisks, question marks, and brackets} {unix} { + lsort [glob globTest/*] +} {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} +test filename-14.7.1 {asterisks, question marks, and brackets} {win} { + lsort [glob globTest/*] +} {globTest/.1 globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} +test filename-14.9 {asterisks, question marks, and brackets} {unixOrPc} { + lsort [glob globTest/.*] +} {globTest/. globTest/.. globTest/.1} +test filename-14.11 {asterisks, question marks, and brackets} {unixOrPc} { + lsort [glob globTest/*/*] +} {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3} +test filename-14.13 {asterisks, question marks, and brackets} {unixOrPc} { + lsort [glob {globTest/[xyab]1.*}] +} {globTest/x1.c globTest/y1.c} +test filename-14.17 {asterisks, question marks, and brackets} -constraints tcl -setup { + global env + set temp $env(HOME) +} -body { + set env(HOME) [file join $env(HOME) globTest] + glob ~/z* +} -cleanup { + set env(HOME) $temp +} -result [list [file join $env(HOME) globTest z1.c]] +test filename-14.18 {asterisks, question marks, and brackets} {unixOrPc} { + lsort [glob globTest/*.c goo/*] +} {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} +test filename-14.20 {asterisks, question marks, and brackets} { + glob -nocomplain goo/* +} {} +test filename-14.21 {asterisks, question marks, and brackets} -body { + glob globTest/*/gorp +} -returnCodes error -result {no files matched glob pattern "globTest/*/gorp"} +test filename-14.22 {asterisks, question marks, and brackets} -body { + glob goo/* x*z foo?q +} -returnCodes error -result {no files matched glob patterns "goo/* x*z foo?q"} +test filename-14.23 {slash globbing} {unix} { + glob / +} / +test filename-14.23.2 {slash globbing} {win} { + glob / +} [file norm /] +test filename-14.24 {slash globbing} {win} { + glob {\\} +} [file norm /] + +test filename-14.31 {Bug 2918610} -setup { + file mkdir foo + set d foo + makeFile {} bar.soom $d +} -body { + foreach fn [glob $d/bar.soom] { + set root [file rootname $fn] + touch $root + } + llength [glob -directory $d *] +} -cleanup { + file delete -force $d + file delete bar.soom + file delete -force foo +} -result 2 + +unset globname + + +test filename-17.3 {Bug 2571597} win { + set p /a + file pathtype $p + file normalize $p + file pathtype $p +} volumerelative + +test fileName-18.1 {windows - split ADS name correctly} {win} { + # bug 1194458 + set x [file split c:/c:d] + list $x [file join {*}$x] +} {{c:/ ./c:d} c:/c:d} + +test fileName-19.1 {ensure that [Bug 1325099] stays fixed} { + # Any non-crashing result is OK + list [file exists ~//.nonexistant_file] [file exists ~///.nonexistant_file] +} {0 0} + +test fileName-20.1 {Bug 1750300} -setup { + set d [makeDirectory foo] + makeFile {} TAGS $d +} -body { + llength [glob -nocomplain -directory $d -- TAGS one two] +} -cleanup { + removeFile TAGS $d + removeDirectory foo +} -result 1 +test fileName-20.6 {Bug 2837800} -setup { + # Recall that we have $env(HOME) set so that references + # to ~ point to [temporaryDirectory] + makeFile {} test ~ + set dd [makeDirectory isolate] + set d [makeDirectory ./~ $dd] + set savewd [pwd] + cd $dd +} -body { + glob -nocomplain */test +} -cleanup { + cd $savewd + removeDirectory ./~ $dd + removeDirectory isolate + removeFile test ~ +} -result {} +test fileName-20.7 {Bug 2806250} -setup { + set savewd [pwd] + cd [temporaryDirectory] + set d [makeDirectory isolate] + makeFile {} ./~test $d +} -body { + file exists [lindex [glob -nocomplain isolate/*] 0] +} -cleanup { + removeFile ./~test $d + removeDirectory isolate + cd $savewd +} -result 1 + +# cleanup +catch {file delete -force C:/globTest} +cd [temporaryDirectory] +file delete -force globTest +cd $oldpwd +set env(HOME) $oldhome +catch {unset oldhome temp result globPreResult} +::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# End: -- cgit v1.1