253 lines
8.5 KiB
Plaintext
253 lines
8.5 KiB
Plaintext
# 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-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:
|