1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280
|
# 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
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:
|