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 <steveb@workware.net.au>

1 files changed, 344 insertions, 0 deletions

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: