# 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 constraint expr win {$tcl_platform(platform) eq "windows"} constraint expr unix {$tcl_platform(platform) eq "unix"} testConstraint unixOrPc 1 proc touch filename {catch {close [open $filename w]}} global env 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} { 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]]] # 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} { 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]]] 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} { 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.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} { glob / } / 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-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 # 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: