[25] | 1 | # This file tests the filename manipulation routines. |
---|
| 2 | # |
---|
| 3 | # This file contains a collection of tests for one or more of the Tcl |
---|
| 4 | # built-in commands. Sourcing this file into Tcl runs the tests and |
---|
| 5 | # generates output for errors. No output means no errors were found. |
---|
| 6 | # |
---|
| 7 | # Copyright (c) 1995-1996 Sun Microsystems, Inc. |
---|
| 8 | # Copyright (c) 1999 by Scriptics Corporation. |
---|
| 9 | # |
---|
| 10 | # See the file "license.terms" for information on usage and redistribution |
---|
| 11 | # of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
| 12 | # |
---|
| 13 | # RCS: @(#) $Id: fileName.test,v 1.51 2006/03/21 11:12:29 dkf Exp $ |
---|
| 14 | |
---|
| 15 | if {[lsearch [namespace children] ::tcltest] == -1} { |
---|
| 16 | package require tcltest |
---|
| 17 | namespace import -force ::tcltest::* |
---|
| 18 | } |
---|
| 19 | |
---|
| 20 | testConstraint testsetplatform [llength [info commands testsetplatform]] |
---|
| 21 | testConstraint testtranslatefilename [llength [info commands testtranslatefilename]] |
---|
| 22 | testConstraint linkDirectory 1 |
---|
| 23 | testConstraint symbolicLinkFile 1 |
---|
| 24 | if {[testConstraint win]} { |
---|
| 25 | if {[string index $tcl_platform(osVersion) 0] < 5 \ |
---|
| 26 | || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} { |
---|
| 27 | testConstraint linkDirectory 0 |
---|
| 28 | } |
---|
| 29 | testConstraint symbolicLinkFile 0 |
---|
| 30 | } |
---|
| 31 | |
---|
| 32 | global env |
---|
| 33 | if {[testConstraint testsetplatform]} { |
---|
| 34 | set platform [testgetplatform] |
---|
| 35 | } |
---|
| 36 | |
---|
| 37 | # Caution: when using 'testsetplatform' to test different file |
---|
| 38 | # name platform descriptions in this file, one must be very |
---|
| 39 | # careful not to combine such platform manipulation with |
---|
| 40 | # commands like 'cd', 'pwd'. That is because the latter commands |
---|
| 41 | # operate on the real filesystem but will potentially have their |
---|
| 42 | # logic routed through the wrong generic code paths if we've |
---|
| 43 | # used 'testsetplatform'. This can lead to serious problems, |
---|
| 44 | # even crashes. |
---|
| 45 | test filename-1.1 {Tcl_GetPathType: unix} {testsetplatform} { |
---|
| 46 | testsetplatform unix |
---|
| 47 | file pathtype / |
---|
| 48 | } absolute |
---|
| 49 | test filename-1.2 {Tcl_GetPathType: unix} {testsetplatform} { |
---|
| 50 | testsetplatform unix |
---|
| 51 | file pathtype /foo |
---|
| 52 | } absolute |
---|
| 53 | test filename-1.3 {Tcl_GetPathType: unix} {testsetplatform} { |
---|
| 54 | testsetplatform unix |
---|
| 55 | file pathtype foo |
---|
| 56 | } relative |
---|
| 57 | test filename-1.4 {Tcl_GetPathType: unix} {testsetplatform} { |
---|
| 58 | testsetplatform unix |
---|
| 59 | file pathtype c:/foo |
---|
| 60 | } relative |
---|
| 61 | test filename-1.5 {Tcl_GetPathType: unix} {testsetplatform} { |
---|
| 62 | testsetplatform unix |
---|
| 63 | file pathtype ~ |
---|
| 64 | } absolute |
---|
| 65 | test filename-1.6 {Tcl_GetPathType: unix} {testsetplatform} { |
---|
| 66 | testsetplatform unix |
---|
| 67 | file pathtype ~/foo |
---|
| 68 | } absolute |
---|
| 69 | test filename-1.7 {Tcl_GetPathType: unix} {testsetplatform} { |
---|
| 70 | testsetplatform unix |
---|
| 71 | file pathtype ~foo |
---|
| 72 | } absolute |
---|
| 73 | test filename-1.8 {Tcl_GetPathType: unix} {testsetplatform} { |
---|
| 74 | testsetplatform unix |
---|
| 75 | file pathtype ./~foo |
---|
| 76 | } relative |
---|
| 77 | |
---|
| 78 | test filename-3.1 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 79 | testsetplatform windows |
---|
| 80 | file pathtype / |
---|
| 81 | } volumerelative |
---|
| 82 | test filename-3.2 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 83 | testsetplatform windows |
---|
| 84 | file pathtype \\ |
---|
| 85 | } volumerelative |
---|
| 86 | test filename-3.3 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 87 | testsetplatform windows |
---|
| 88 | file pathtype /foo |
---|
| 89 | } volumerelative |
---|
| 90 | test filename-3.4 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 91 | testsetplatform windows |
---|
| 92 | file pathtype \\foo |
---|
| 93 | } volumerelative |
---|
| 94 | test filename-3.5 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 95 | testsetplatform windows |
---|
| 96 | file pathtype c:/ |
---|
| 97 | } absolute |
---|
| 98 | test filename-3.6 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 99 | testsetplatform windows |
---|
| 100 | file pathtype c:\\ |
---|
| 101 | } absolute |
---|
| 102 | test filename-3.7 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 103 | testsetplatform windows |
---|
| 104 | file pathtype c:/foo |
---|
| 105 | } absolute |
---|
| 106 | test filename-3.8 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 107 | testsetplatform windows |
---|
| 108 | file pathtype c:\\foo |
---|
| 109 | } absolute |
---|
| 110 | test filename-3.9 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 111 | testsetplatform windows |
---|
| 112 | file pathtype c: |
---|
| 113 | } volumerelative |
---|
| 114 | test filename-3.10 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 115 | testsetplatform windows |
---|
| 116 | file pathtype c:foo |
---|
| 117 | } volumerelative |
---|
| 118 | test filename-3.11 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 119 | testsetplatform windows |
---|
| 120 | file pathtype foo |
---|
| 121 | } relative |
---|
| 122 | test filename-3.12 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 123 | testsetplatform windows |
---|
| 124 | file pathtype //foo/bar |
---|
| 125 | } absolute |
---|
| 126 | test filename-3.13 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 127 | testsetplatform windows |
---|
| 128 | file pathtype ~foo |
---|
| 129 | } absolute |
---|
| 130 | test filename-3.14 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 131 | testsetplatform windows |
---|
| 132 | file pathtype ~ |
---|
| 133 | } absolute |
---|
| 134 | test filename-3.15 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 135 | testsetplatform windows |
---|
| 136 | file pathtype ~/foo |
---|
| 137 | } absolute |
---|
| 138 | test filename-3.16 {Tcl_GetPathType: windows} {testsetplatform} { |
---|
| 139 | testsetplatform windows |
---|
| 140 | file pathtype ./~foo |
---|
| 141 | } relative |
---|
| 142 | |
---|
| 143 | test filename-4.1 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 144 | testsetplatform unix |
---|
| 145 | file split / |
---|
| 146 | } {/} |
---|
| 147 | test filename-4.2 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 148 | testsetplatform unix |
---|
| 149 | file split /foo |
---|
| 150 | } {/ foo} |
---|
| 151 | test filename-4.3 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 152 | testsetplatform unix |
---|
| 153 | file split /foo/bar |
---|
| 154 | } {/ foo bar} |
---|
| 155 | test filename-4.4 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 156 | testsetplatform unix |
---|
| 157 | file split /foo/bar/baz |
---|
| 158 | } {/ foo bar baz} |
---|
| 159 | test filename-4.5 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 160 | testsetplatform unix |
---|
| 161 | file split foo/bar |
---|
| 162 | } {foo bar} |
---|
| 163 | test filename-4.6 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 164 | testsetplatform unix |
---|
| 165 | file split ./foo/bar |
---|
| 166 | } {. foo bar} |
---|
| 167 | test filename-4.7 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 168 | testsetplatform unix |
---|
| 169 | file split /foo/../././foo/bar |
---|
| 170 | } {/ foo .. . . foo bar} |
---|
| 171 | test filename-4.8 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 172 | testsetplatform unix |
---|
| 173 | file split ../foo/bar |
---|
| 174 | } {.. foo bar} |
---|
| 175 | test filename-4.9 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 176 | testsetplatform unix |
---|
| 177 | file split {} |
---|
| 178 | } {} |
---|
| 179 | test filename-4.10 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 180 | testsetplatform unix |
---|
| 181 | file split . |
---|
| 182 | } {.} |
---|
| 183 | test filename-4.11 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 184 | testsetplatform unix |
---|
| 185 | file split ../ |
---|
| 186 | } {..} |
---|
| 187 | test filename-4.12 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 188 | testsetplatform unix |
---|
| 189 | file split ../.. |
---|
| 190 | } {.. ..} |
---|
| 191 | test filename-4.13 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 192 | testsetplatform unix |
---|
| 193 | file split //foo |
---|
| 194 | } {/ foo} |
---|
| 195 | test filename-4.14 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 196 | testsetplatform unix |
---|
| 197 | file split foo//bar |
---|
| 198 | } {foo bar} |
---|
| 199 | test filename-4.15 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 200 | testsetplatform unix |
---|
| 201 | file split ~foo |
---|
| 202 | } {~foo} |
---|
| 203 | test filename-4.16 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 204 | testsetplatform unix |
---|
| 205 | file split ~foo/~bar |
---|
| 206 | } {~foo ./~bar} |
---|
| 207 | test filename-4.17 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 208 | testsetplatform unix |
---|
| 209 | file split ~foo/~bar/~baz |
---|
| 210 | } {~foo ./~bar ./~baz} |
---|
| 211 | test filename-4.18 {Tcl_SplitPath: unix} {testsetplatform} { |
---|
| 212 | testsetplatform unix |
---|
| 213 | file split foo/bar~/baz |
---|
| 214 | } {foo bar~ baz} |
---|
| 215 | |
---|
| 216 | if {[testConstraint testsetplatform]} { |
---|
| 217 | testsetplatform $platform |
---|
| 218 | } |
---|
| 219 | |
---|
| 220 | test filename-4.19 {Tcl_SplitPath} { |
---|
| 221 | set oldDir [pwd] |
---|
| 222 | set res [catch { |
---|
| 223 | cd [temporaryDirectory] |
---|
| 224 | file mkdir tildetmp |
---|
| 225 | set nastydir [file join tildetmp ./~tilde] |
---|
| 226 | file mkdir $nastydir |
---|
| 227 | set norm [file normalize $nastydir] |
---|
| 228 | cd tildetmp |
---|
| 229 | cd ./~tilde |
---|
| 230 | glob -nocomplain * |
---|
| 231 | set idx [string first tildetmp $norm] |
---|
| 232 | set norm [string range $norm $idx end] |
---|
| 233 | # fix path away so all platforms are the same |
---|
| 234 | regsub {(.*):$} $norm {\1} norm |
---|
| 235 | regsub -all ":" $norm "/" norm |
---|
| 236 | # make sure we can delete the directory we created |
---|
| 237 | cd $oldDir |
---|
| 238 | file delete -force $nastydir |
---|
| 239 | set norm |
---|
| 240 | } err] |
---|
| 241 | cd $oldDir |
---|
| 242 | catch {file delete -force [file join [temporaryDirectory] tildetmp]} |
---|
| 243 | list $res $err |
---|
| 244 | } {0 tildetmp/~tilde} |
---|
| 245 | |
---|
| 246 | test filename-6.1 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 247 | testsetplatform win |
---|
| 248 | file split / |
---|
| 249 | } {/} |
---|
| 250 | test filename-6.2 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 251 | testsetplatform win |
---|
| 252 | file split /foo |
---|
| 253 | } {/ foo} |
---|
| 254 | test filename-6.3 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 255 | testsetplatform win |
---|
| 256 | file split /foo/bar |
---|
| 257 | } {/ foo bar} |
---|
| 258 | test filename-6.4 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 259 | testsetplatform win |
---|
| 260 | file split /foo/bar/baz |
---|
| 261 | } {/ foo bar baz} |
---|
| 262 | test filename-6.5 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 263 | testsetplatform win |
---|
| 264 | file split foo/bar |
---|
| 265 | } {foo bar} |
---|
| 266 | test filename-6.6 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 267 | testsetplatform win |
---|
| 268 | file split ./foo/bar |
---|
| 269 | } {. foo bar} |
---|
| 270 | test filename-6.7 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 271 | testsetplatform win |
---|
| 272 | file split /foo/../././foo/bar |
---|
| 273 | } {/ foo .. . . foo bar} |
---|
| 274 | test filename-6.8 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 275 | testsetplatform win |
---|
| 276 | file split ../foo/bar |
---|
| 277 | } {.. foo bar} |
---|
| 278 | test filename-6.9 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 279 | testsetplatform win |
---|
| 280 | file split {} |
---|
| 281 | } {} |
---|
| 282 | test filename-6.10 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 283 | testsetplatform win |
---|
| 284 | file split . |
---|
| 285 | } {.} |
---|
| 286 | test filename-6.11 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 287 | testsetplatform win |
---|
| 288 | file split ../ |
---|
| 289 | } {..} |
---|
| 290 | test filename-6.12 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 291 | testsetplatform win |
---|
| 292 | file split ../.. |
---|
| 293 | } {.. ..} |
---|
| 294 | test filename-6.13 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 295 | testsetplatform win |
---|
| 296 | file split //foo |
---|
| 297 | } {/ foo} |
---|
| 298 | test filename-6.14 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 299 | testsetplatform win |
---|
| 300 | file split foo//bar |
---|
| 301 | } {foo bar} |
---|
| 302 | test filename-6.15 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 303 | testsetplatform win |
---|
| 304 | file split /\\/foo//bar |
---|
| 305 | } {//foo/bar} |
---|
| 306 | test filename-6.16 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 307 | testsetplatform win |
---|
| 308 | file split /\\/foo//bar |
---|
| 309 | } {//foo/bar} |
---|
| 310 | test filename-6.17 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 311 | testsetplatform win |
---|
| 312 | file split /\\/foo//bar |
---|
| 313 | } {//foo/bar} |
---|
| 314 | test filename-6.18 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 315 | testsetplatform win |
---|
| 316 | file split \\\\foo\\bar |
---|
| 317 | } {//foo/bar} |
---|
| 318 | test filename-6.19 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 319 | testsetplatform win |
---|
| 320 | file split \\\\foo\\bar/baz |
---|
| 321 | } {//foo/bar baz} |
---|
| 322 | test filename-6.20 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 323 | testsetplatform win |
---|
| 324 | file split c:/foo |
---|
| 325 | } {c:/ foo} |
---|
| 326 | test filename-6.21 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 327 | testsetplatform win |
---|
| 328 | file split c:foo |
---|
| 329 | } {c: foo} |
---|
| 330 | test filename-6.22 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 331 | testsetplatform win |
---|
| 332 | file split c: |
---|
| 333 | } {c:} |
---|
| 334 | test filename-6.23 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 335 | testsetplatform win |
---|
| 336 | file split c:\\ |
---|
| 337 | } {c:/} |
---|
| 338 | test filename-6.24 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 339 | testsetplatform win |
---|
| 340 | file split c:/ |
---|
| 341 | } {c:/} |
---|
| 342 | test filename-6.25 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 343 | testsetplatform win |
---|
| 344 | file split c:/./.. |
---|
| 345 | } {c:/ . ..} |
---|
| 346 | test filename-6.26 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 347 | testsetplatform win |
---|
| 348 | file split ~foo |
---|
| 349 | } {~foo} |
---|
| 350 | test filename-6.27 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 351 | testsetplatform win |
---|
| 352 | file split ~foo/~bar |
---|
| 353 | } {~foo ./~bar} |
---|
| 354 | test filename-6.28 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 355 | testsetplatform win |
---|
| 356 | file split ~foo/~bar/~baz |
---|
| 357 | } {~foo ./~bar ./~baz} |
---|
| 358 | test filename-6.29 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 359 | testsetplatform win |
---|
| 360 | file split foo/bar~/baz |
---|
| 361 | } {foo bar~ baz} |
---|
| 362 | test filename-6.30 {Tcl_SplitPath: win} {testsetplatform} { |
---|
| 363 | testsetplatform win |
---|
| 364 | file split c:~foo |
---|
| 365 | } {c: ./~foo} |
---|
| 366 | |
---|
| 367 | test filename-7.1 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 368 | testsetplatform unix |
---|
| 369 | file join / a |
---|
| 370 | } {/a} |
---|
| 371 | test filename-7.2 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 372 | testsetplatform unix |
---|
| 373 | file join a b |
---|
| 374 | } {a/b} |
---|
| 375 | test filename-7.3 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 376 | testsetplatform unix |
---|
| 377 | file join /a c /b d |
---|
| 378 | } {/b/d} |
---|
| 379 | test filename-7.4 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 380 | testsetplatform unix |
---|
| 381 | file join / |
---|
| 382 | } {/} |
---|
| 383 | test filename-7.5 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 384 | testsetplatform unix |
---|
| 385 | file join a |
---|
| 386 | } {a} |
---|
| 387 | test filename-7.6 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 388 | testsetplatform unix |
---|
| 389 | file join {} |
---|
| 390 | } {} |
---|
| 391 | test filename-7.7 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 392 | testsetplatform unix |
---|
| 393 | file join /a/ b |
---|
| 394 | } {/a/b} |
---|
| 395 | test filename-7.8 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 396 | testsetplatform unix |
---|
| 397 | file join /a// b |
---|
| 398 | } {/a/b} |
---|
| 399 | test filename-7.9 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 400 | testsetplatform unix |
---|
| 401 | file join /a/./../. b |
---|
| 402 | } {/a/./.././b} |
---|
| 403 | test filename-7.10 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 404 | testsetplatform unix |
---|
| 405 | file join ~ a |
---|
| 406 | } {~/a} |
---|
| 407 | test filename-7.11 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 408 | testsetplatform unix |
---|
| 409 | file join ~a ~b |
---|
| 410 | } {~b} |
---|
| 411 | test filename-7.12 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 412 | testsetplatform unix |
---|
| 413 | file join ./~a b |
---|
| 414 | } {./~a/b} |
---|
| 415 | test filename-7.13 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 416 | testsetplatform unix |
---|
| 417 | file join ./~a ~b |
---|
| 418 | } {~b} |
---|
| 419 | test filename-7.14 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 420 | testsetplatform unix |
---|
| 421 | file join ./~a ./~b |
---|
| 422 | } {./~a/~b} |
---|
| 423 | test filename-7.15 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 424 | testsetplatform unix |
---|
| 425 | file join a . b |
---|
| 426 | } {a/./b} |
---|
| 427 | test filename-7.16 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 428 | testsetplatform unix |
---|
| 429 | file join a . ./~b |
---|
| 430 | } {a/./~b} |
---|
| 431 | test filename-7.17 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 432 | testsetplatform unix |
---|
| 433 | file join //a b |
---|
| 434 | } {/a/b} |
---|
| 435 | test filename-7.18 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 436 | testsetplatform unix |
---|
| 437 | file join /// a b |
---|
| 438 | } {/a/b} |
---|
| 439 | |
---|
| 440 | |
---|
| 441 | test filename-9.1 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 442 | testsetplatform win |
---|
| 443 | file join a b |
---|
| 444 | } {a/b} |
---|
| 445 | test filename-9.2 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 446 | testsetplatform win |
---|
| 447 | file join /a b |
---|
| 448 | } {/a/b} |
---|
| 449 | test filename-9.3 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 450 | testsetplatform win |
---|
| 451 | file join /a /b |
---|
| 452 | } {/b} |
---|
| 453 | test filename-9.4 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 454 | testsetplatform win |
---|
| 455 | file join c: foo |
---|
| 456 | } {c:foo} |
---|
| 457 | test filename-9.5 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 458 | testsetplatform win |
---|
| 459 | file join c:/ foo |
---|
| 460 | } {c:/foo} |
---|
| 461 | test filename-9.6 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 462 | testsetplatform win |
---|
| 463 | file join c:\\bar foo |
---|
| 464 | } {c:/bar/foo} |
---|
| 465 | test filename-9.7 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 466 | testsetplatform win |
---|
| 467 | file join /foo c:bar |
---|
| 468 | } {c:bar} |
---|
| 469 | test filename-9.8 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 470 | testsetplatform win |
---|
| 471 | file join ///host//share dir |
---|
| 472 | } {//host/share/dir} |
---|
| 473 | test filename-9.9 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 474 | testsetplatform win |
---|
| 475 | file join ~ foo |
---|
| 476 | } {~/foo} |
---|
| 477 | test filename-9.10 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 478 | testsetplatform win |
---|
| 479 | file join ~/~foo |
---|
| 480 | } {~/~foo} |
---|
| 481 | test filename-9.11 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 482 | testsetplatform win |
---|
| 483 | file join ~ ./~foo |
---|
| 484 | } {~/~foo} |
---|
| 485 | test filename-9.12 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 486 | testsetplatform win |
---|
| 487 | file join / ~foo |
---|
| 488 | } {~foo} |
---|
| 489 | test filename-9.13 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 490 | testsetplatform win |
---|
| 491 | file join ./a/ b c |
---|
| 492 | } {./a/b/c} |
---|
| 493 | test filename-9.14 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 494 | testsetplatform win |
---|
| 495 | file join ./~a/ b c |
---|
| 496 | } {./~a/b/c} |
---|
| 497 | test filename-9.15 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 498 | testsetplatform win |
---|
| 499 | file join // host share path |
---|
| 500 | } {/host/share/path} |
---|
| 501 | test filename-9.16 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 502 | testsetplatform win |
---|
| 503 | file join foo . bar |
---|
| 504 | } {foo/./bar} |
---|
| 505 | test filename-9.17 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 506 | testsetplatform win |
---|
| 507 | file join foo .. bar |
---|
| 508 | } {foo/../bar} |
---|
| 509 | test filename-9.18 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 510 | testsetplatform win |
---|
| 511 | file join foo/./bar |
---|
| 512 | } {foo/./bar} |
---|
| 513 | test filename-9.19 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 514 | testsetplatform win |
---|
| 515 | set res {} |
---|
| 516 | lappend res \ |
---|
| 517 | [file join {C:\foo\bar}] \ |
---|
| 518 | [file join C:/blah {C:\foo\bar}] \ |
---|
| 519 | [file join C:/blah C:/blah {C:\foo\bar}] |
---|
| 520 | } {C:/foo/bar C:/foo/bar C:/foo/bar} |
---|
| 521 | test filename-9.19.1 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 522 | testsetplatform win |
---|
| 523 | set res {} |
---|
| 524 | lappend res \ |
---|
| 525 | [file join {foo\bar}] \ |
---|
| 526 | [file join C:/blah {foo\bar}] \ |
---|
| 527 | [file join C:/blah C:/blah {foo\bar}] |
---|
| 528 | } {foo/bar C:/blah/foo/bar C:/blah/foo/bar} |
---|
| 529 | test filename-9.19.2 {Tcl_JoinPath: win} {testsetplatform win} { |
---|
| 530 | testsetplatform win |
---|
| 531 | set res {} |
---|
| 532 | lappend res \ |
---|
| 533 | [file join {foo\bar}] \ |
---|
| 534 | [file join [pwd] {foo\bar}] \ |
---|
| 535 | [file join [pwd] [pwd] {foo\bar}] |
---|
| 536 | set nres {} |
---|
| 537 | foreach elt $res { |
---|
| 538 | lappend nres [string map [list [pwd] pwd] $elt] |
---|
| 539 | } |
---|
| 540 | set nres |
---|
| 541 | } {foo/bar pwd/foo/bar pwd/foo/bar} |
---|
| 542 | test filename-9.20 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 543 | testsetplatform unix |
---|
| 544 | set res {} |
---|
| 545 | lappend res \ |
---|
| 546 | [file join {/foo/bar}] \ |
---|
| 547 | [file join /x {/foo/bar}] \ |
---|
| 548 | [file join /x /x {/foo/bar}] |
---|
| 549 | } {/foo/bar /foo/bar /foo/bar} |
---|
| 550 | test filename-9.23 {Tcl_JoinPath: win} {testsetplatform} { |
---|
| 551 | testsetplatform win |
---|
| 552 | set res {} |
---|
| 553 | lappend res \ |
---|
| 554 | [file join {foo\bar}] \ |
---|
| 555 | [file join C:/blah {foo\bar}] \ |
---|
| 556 | [file join C:/blah C:/blah {foo\bar}] |
---|
| 557 | string map [list C:/blah ""] $res |
---|
| 558 | } {foo/bar /foo/bar /foo/bar} |
---|
| 559 | test filename-9.24 {Tcl_JoinPath: unix} {testsetplatform} { |
---|
| 560 | testsetplatform unix |
---|
| 561 | set res {} |
---|
| 562 | lappend res \ |
---|
| 563 | [file join {foo/bar}] \ |
---|
| 564 | [file join /x {foo/bar}] \ |
---|
| 565 | [file join /x /x {foo/bar}] |
---|
| 566 | string map [list /x ""] $res |
---|
| 567 | } {foo/bar /foo/bar /foo/bar} |
---|
| 568 | |
---|
| 569 | test filename-10.1 {Tcl_TranslateFileName} {testsetplatform} { |
---|
| 570 | testsetplatform unix |
---|
| 571 | list [catch {testtranslatefilename foo} msg] $msg |
---|
| 572 | } {0 foo} |
---|
| 573 | test filename-10.2 {Tcl_TranslateFileName} {testsetplatform} { |
---|
| 574 | testsetplatform windows |
---|
| 575 | list [catch {testtranslatefilename {c:/foo}} msg] $msg |
---|
| 576 | } {0 {c:\foo}} |
---|
| 577 | test filename-10.3 {Tcl_TranslateFileName} {testsetplatform} { |
---|
| 578 | testsetplatform windows |
---|
| 579 | list [catch {testtranslatefilename {c:/\\foo/}} msg] $msg |
---|
| 580 | } {0 {c:\foo}} |
---|
| 581 | test filename-10.3.1 {Tcl_TranslateFileName} {testsetplatform} { |
---|
| 582 | testsetplatform windows |
---|
| 583 | list [catch {testtranslatefilename {c://///}} msg] $msg |
---|
| 584 | } {0 c:\\} |
---|
| 585 | test filename-10.6 {Tcl_TranslateFileName} {testsetplatform} { |
---|
| 586 | global env |
---|
| 587 | set temp $env(HOME) |
---|
| 588 | set env(HOME) "/home/test" |
---|
| 589 | testsetplatform unix |
---|
| 590 | set result [list [catch {testtranslatefilename ~/foo} msg] $msg] |
---|
| 591 | set env(HOME) $temp |
---|
| 592 | set result |
---|
| 593 | } {0 /home/test/foo} |
---|
| 594 | test filename-10.7 {Tcl_TranslateFileName} {testsetplatform} { |
---|
| 595 | global env |
---|
| 596 | set temp $env(HOME) |
---|
| 597 | unset env(HOME) |
---|
| 598 | testsetplatform unix |
---|
| 599 | set result [list [catch {testtranslatefilename ~/foo} msg] $msg] |
---|
| 600 | set env(HOME) $temp |
---|
| 601 | set result |
---|
| 602 | } {1 {couldn't find HOME environment variable to expand path}} |
---|
| 603 | test filename-10.8 {Tcl_TranslateFileName} {testsetplatform} { |
---|
| 604 | global env |
---|
| 605 | set temp $env(HOME) |
---|
| 606 | set env(HOME) "/home/test" |
---|
| 607 | testsetplatform unix |
---|
| 608 | set result [list [catch {testtranslatefilename ~} msg] $msg] |
---|
| 609 | set env(HOME) $temp |
---|
| 610 | set result |
---|
| 611 | } {0 /home/test} |
---|
| 612 | test filename-10.9 {Tcl_TranslateFileName} {testsetplatform} { |
---|
| 613 | global env |
---|
| 614 | set temp $env(HOME) |
---|
| 615 | set env(HOME) "/home/test/" |
---|
| 616 | testsetplatform unix |
---|
| 617 | set result [list [catch {testtranslatefilename ~} msg] $msg] |
---|
| 618 | set env(HOME) $temp |
---|
| 619 | set result |
---|
| 620 | } {0 /home/test} |
---|
| 621 | test filename-10.10 {Tcl_TranslateFileName} {testsetplatform} { |
---|
| 622 | global env |
---|
| 623 | set temp $env(HOME) |
---|
| 624 | set env(HOME) "/home/test/" |
---|
| 625 | testsetplatform unix |
---|
| 626 | set result [list [catch {testtranslatefilename ~/foo} msg] $msg] |
---|
| 627 | set env(HOME) $temp |
---|
| 628 | set result |
---|
| 629 | } {0 /home/test/foo} |
---|
| 630 | test filename-10.17 {Tcl_TranslateFileName} {testsetplatform} { |
---|
| 631 | global env |
---|
| 632 | set temp $env(HOME) |
---|
| 633 | set env(HOME) "\\home\\" |
---|
| 634 | testsetplatform windows |
---|
| 635 | set result [list [catch {testtranslatefilename ~/foo} msg] $msg] |
---|
| 636 | set env(HOME) $temp |
---|
| 637 | set result |
---|
| 638 | } {0 {\home\foo}} |
---|
| 639 | test filename-10.18 {Tcl_TranslateFileName} {testsetplatform} { |
---|
| 640 | global env |
---|
| 641 | set temp $env(HOME) |
---|
| 642 | set env(HOME) "\\home\\" |
---|
| 643 | testsetplatform windows |
---|
| 644 | set result [list [catch {testtranslatefilename ~/foo\\bar} msg] $msg] |
---|
| 645 | set env(HOME) $temp |
---|
| 646 | set result |
---|
| 647 | } {0 {\home\foo\bar}} |
---|
| 648 | test filename-10.19 {Tcl_TranslateFileName} {testsetplatform} { |
---|
| 649 | global env |
---|
| 650 | set temp $env(HOME) |
---|
| 651 | set env(HOME) "c:" |
---|
| 652 | testsetplatform windows |
---|
| 653 | set result [list [catch {testtranslatefilename ~/foo} msg] $msg] |
---|
| 654 | set env(HOME) $temp |
---|
| 655 | set result |
---|
| 656 | } {0 c:foo} |
---|
| 657 | test filename-10.20 {Tcl_TranslateFileName} {testtranslatefilename} { |
---|
| 658 | list [catch {testtranslatefilename ~blorp/foo} msg] $msg |
---|
| 659 | } {1 {user "blorp" doesn't exist}} |
---|
| 660 | test filename-10.21 {Tcl_TranslateFileName} {testsetplatform} { |
---|
| 661 | global env |
---|
| 662 | set temp $env(HOME) |
---|
| 663 | set env(HOME) "c:\\" |
---|
| 664 | testsetplatform windows |
---|
| 665 | set result [list [catch {testtranslatefilename ~/foo} msg] $msg] |
---|
| 666 | set env(HOME) $temp |
---|
| 667 | set result |
---|
| 668 | } {0 {c:\foo}} |
---|
| 669 | test filename-10.22 {Tcl_TranslateFileName} {testsetplatform} { |
---|
| 670 | testsetplatform windows |
---|
| 671 | list [catch {testtranslatefilename foo//bar} msg] $msg |
---|
| 672 | } {0 {foo\bar}} |
---|
| 673 | |
---|
| 674 | if {[testConstraint testsetplatform]} { |
---|
| 675 | testsetplatform $platform |
---|
| 676 | } |
---|
| 677 | |
---|
| 678 | test filename-10.23 {Tcl_TranslateFileName} {nonPortable} { |
---|
| 679 | # this test fails if ~ouster is not /home/ouster |
---|
| 680 | list [catch {testtranslatefilename ~ouster} msg] $msg |
---|
| 681 | } {0 /home/ouster} |
---|
| 682 | test filename-10.24 {Tcl_TranslateFileName} {nonPortable} { |
---|
| 683 | # this test fails if ~ouster is not /home/ouster |
---|
| 684 | list [catch {testtranslatefilename ~ouster/foo} msg] $msg |
---|
| 685 | } {0 /home/ouster/foo} |
---|
| 686 | |
---|
| 687 | |
---|
| 688 | test filename-11.1 {Tcl_GlobCmd} { |
---|
| 689 | list [catch {glob} msg] $msg |
---|
| 690 | } {1 {wrong # args: should be "glob ?switches? name ?name ...?"}} |
---|
| 691 | test filename-11.2 {Tcl_GlobCmd} { |
---|
| 692 | list [catch {glob -gorp} msg] $msg |
---|
| 693 | } {1 {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}} |
---|
| 694 | test filename-11.3 {Tcl_GlobCmd} { |
---|
| 695 | list [catch {glob -nocomplai} msg] $msg |
---|
| 696 | } {1 {wrong # args: should be "glob ?switches? name ?name ...?"}} |
---|
| 697 | test filename-11.4 {Tcl_GlobCmd} { |
---|
| 698 | list [catch {glob -nocomplain} msg] $msg |
---|
| 699 | } {1 {wrong # args: should be "glob ?switches? name ?name ...?"}} |
---|
| 700 | test filename-11.5 {Tcl_GlobCmd} { |
---|
| 701 | list [catch {glob -nocomplain * ~xyqrszzz} msg] $msg |
---|
| 702 | } {1 {user "xyqrszzz" doesn't exist}} |
---|
| 703 | test filename-11.6 {Tcl_GlobCmd} { |
---|
| 704 | list [catch {glob ~xyqrszzz} msg] $msg |
---|
| 705 | } {1 {user "xyqrszzz" doesn't exist}} |
---|
| 706 | test filename-11.7 {Tcl_GlobCmd} { |
---|
| 707 | list [catch {glob -- -nocomplain} msg] $msg |
---|
| 708 | } {1 {no files matched glob pattern "-nocomplain"}} |
---|
| 709 | test filename-11.8 {Tcl_GlobCmd} { |
---|
| 710 | list [catch {glob -nocomplain -- -nocomplain} msg] $msg |
---|
| 711 | } {0 {}} |
---|
| 712 | test filename-11.9 {Tcl_GlobCmd} {testsetplatform} { |
---|
| 713 | testsetplatform unix |
---|
| 714 | list [catch {glob ~\\xyqrszzz/bar} msg] $msg |
---|
| 715 | } {1 {user "\xyqrszzz" doesn't exist}} |
---|
| 716 | test filename-11.10 {Tcl_GlobCmd} {testsetplatform} { |
---|
| 717 | testsetplatform unix |
---|
| 718 | list [catch {glob -nocomplain ~\\xyqrszzz/bar} msg] $msg |
---|
| 719 | } {1 {user "\xyqrszzz" doesn't exist}} |
---|
| 720 | test filename-11.11 {Tcl_GlobCmd} {testsetplatform} { |
---|
| 721 | testsetplatform unix |
---|
| 722 | list [catch {glob ~xyqrszzz\\/\\bar} msg] $msg |
---|
| 723 | } {1 {user "xyqrszzz" doesn't exist}} |
---|
| 724 | test filename-11.12 {Tcl_GlobCmd} {testsetplatform} { |
---|
| 725 | testsetplatform unix |
---|
| 726 | set home $env(HOME) |
---|
| 727 | unset env(HOME) |
---|
| 728 | set x [list [catch {glob ~/*} msg] $msg] |
---|
| 729 | set env(HOME) $home |
---|
| 730 | set x |
---|
| 731 | } {1 {couldn't find HOME environment variable to expand path}} |
---|
| 732 | |
---|
| 733 | if {[testConstraint testsetplatform]} { |
---|
| 734 | testsetplatform $platform |
---|
| 735 | } |
---|
| 736 | |
---|
| 737 | test filename-11.13 {Tcl_GlobCmd} { |
---|
| 738 | list [catch {file join [lindex [glob ~] 0]} msg] $msg |
---|
| 739 | } [list 0 [file join $env(HOME)]] |
---|
| 740 | |
---|
| 741 | set oldpwd [pwd] |
---|
| 742 | set oldhome $env(HOME) |
---|
| 743 | cd [temporaryDirectory] |
---|
| 744 | set env(HOME) [pwd] |
---|
| 745 | file delete -force globTest |
---|
| 746 | file mkdir globTest/a1/b1 |
---|
| 747 | file mkdir globTest/a1/b2 |
---|
| 748 | file mkdir globTest/a2/b3 |
---|
| 749 | file mkdir globTest/a3 |
---|
| 750 | close [open globTest/x1.c w] |
---|
| 751 | close [open globTest/y1.c w] |
---|
| 752 | close [open globTest/z1.c w] |
---|
| 753 | close [open "globTest/weird name.c" w] |
---|
| 754 | close [open globTest/a1/b1/x2.c w] |
---|
| 755 | close [open globTest/a1/b2/y2.c w] |
---|
| 756 | |
---|
| 757 | catch {close [open globTest/.1 w]} |
---|
| 758 | catch {close [open globTest/x,z1.c w]} |
---|
| 759 | |
---|
| 760 | test filename-11.14 {Tcl_GlobCmd} { |
---|
| 761 | list [catch {glob ~/globTest} msg] $msg |
---|
| 762 | } [list 0 [list [file join $env(HOME) globTest]]] |
---|
| 763 | test filename-11.15 {Tcl_GlobCmd} { |
---|
| 764 | list [catch {glob ~\\/globTest} msg] $msg |
---|
| 765 | } [list 0 [list [file join $env(HOME) globTest]]] |
---|
| 766 | test filename-11.16 {Tcl_GlobCmd} { |
---|
| 767 | list [catch {glob globTest} msg] $msg |
---|
| 768 | } {0 globTest} |
---|
| 769 | |
---|
| 770 | set globname "globTest" |
---|
| 771 | set horribleglobname "glob\[\{Test" |
---|
| 772 | |
---|
| 773 | test filename-11.17 {Tcl_GlobCmd} {unix} { |
---|
| 774 | list [catch {lsort [glob -directory $globname *]} msg] $msg |
---|
| 775 | } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ |
---|
| 776 | [file join $globname a3]\ |
---|
| 777 | [file join $globname "weird name.c"]\ |
---|
| 778 | [file join $globname x,z1.c]\ |
---|
| 779 | [file join $globname x1.c]\ |
---|
| 780 | [file join $globname y1.c] [file join $globname z1.c]]]] |
---|
| 781 | test filename-11.17.1 {Tcl_GlobCmd} {win} { |
---|
| 782 | list [catch {lsort [glob -directory $globname *]} msg] $msg |
---|
| 783 | } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ |
---|
| 784 | [file join $globname .1]\ |
---|
| 785 | [file join $globname a3]\ |
---|
| 786 | [file join $globname "weird name.c"]\ |
---|
| 787 | [file join $globname x,z1.c]\ |
---|
| 788 | [file join $globname x1.c]\ |
---|
| 789 | [file join $globname y1.c] [file join $globname z1.c]]]] |
---|
| 790 | test filename-11.17.2 {Tcl_GlobCmd} {notRoot linkDirectory} { |
---|
| 791 | set dir [pwd] |
---|
| 792 | set ret "error in test" |
---|
| 793 | if {[catch { |
---|
| 794 | cd $globname |
---|
| 795 | file link -symbolic link a1 |
---|
| 796 | cd $dir |
---|
| 797 | set ret [list [catch { |
---|
| 798 | lsort [glob -directory $globname -join * b1] |
---|
| 799 | } msg] $msg] |
---|
| 800 | }]} { |
---|
| 801 | cd $dir |
---|
| 802 | } |
---|
| 803 | file delete [file join $globname link] |
---|
| 804 | set ret |
---|
| 805 | } [list 0 [lsort [list [file join $globname a1 b1] \ |
---|
| 806 | [file join $globname link b1]]]] |
---|
| 807 | # Simpler version of the above test to illustrate a given bug. |
---|
| 808 | test filename-11.17.3 {Tcl_GlobCmd} {notRoot linkDirectory} { |
---|
| 809 | set dir [pwd] |
---|
| 810 | set ret "error in test" |
---|
| 811 | if {[catch { |
---|
| 812 | cd $globname |
---|
| 813 | file link -symbolic link a1 |
---|
| 814 | cd $dir |
---|
| 815 | set ret [list [catch { |
---|
| 816 | lsort [glob -directory $globname -type d *] |
---|
| 817 | } msg] $msg] |
---|
| 818 | }]} { |
---|
| 819 | cd $dir |
---|
| 820 | } |
---|
| 821 | file delete [file join $globname link] |
---|
| 822 | set ret |
---|
| 823 | } [list 0 [lsort [list [file join $globname a1] \ |
---|
| 824 | [file join $globname a2] \ |
---|
| 825 | [file join $globname a3] \ |
---|
| 826 | [file join $globname link]]]] |
---|
| 827 | # Make sure the bugfix isn't too simple. We don't want |
---|
| 828 | # to break 'glob -type l'. |
---|
| 829 | test filename-11.17.4 {Tcl_GlobCmd} {notRoot linkDirectory} { |
---|
| 830 | set dir [pwd] |
---|
| 831 | set ret "error in test" |
---|
| 832 | if {[catch { |
---|
| 833 | cd $globname |
---|
| 834 | file link -symbolic link a1 |
---|
| 835 | cd $dir |
---|
| 836 | set ret [list [catch { |
---|
| 837 | lsort [glob -directory $globname -type l *] |
---|
| 838 | } msg] $msg] |
---|
| 839 | }]} { |
---|
| 840 | cd $dir |
---|
| 841 | } |
---|
| 842 | file delete [file join $globname link] |
---|
| 843 | set ret |
---|
| 844 | } [list 0 [list [file join $globname link]]] |
---|
| 845 | test filename-11.17.5 {Tcl_GlobCmd} { |
---|
| 846 | list [catch {lsort [glob -directory $globname -tails *.c]} msg] $msg |
---|
| 847 | } [list 0 [lsort [list "weird name.c" x,z1.c x1.c y1.c z1.c]]] |
---|
| 848 | test filename-11.17.6 {Tcl_GlobCmd} { |
---|
| 849 | list [catch {lsort [glob -directory $globname -tails *.c *.c]} msg] $msg |
---|
| 850 | } [list 0 [lsort [concat [list "weird name.c" x,z1.c x1.c y1.c z1.c] \ |
---|
| 851 | [list "weird name.c" x,z1.c x1.c y1.c z1.c]]]] |
---|
| 852 | test filename-11.17.7 {Tcl_GlobCmd: broken link and glob -l} {linkDirectory} { |
---|
| 853 | set dir [pwd] |
---|
| 854 | set ret "error in test" |
---|
| 855 | if {[catch { |
---|
| 856 | cd $globname |
---|
| 857 | file mkdir nonexistent |
---|
| 858 | file link -symbolic link nonexistent |
---|
| 859 | file delete nonexistent |
---|
| 860 | cd $dir |
---|
| 861 | set ret [list [catch { |
---|
| 862 | lsort [glob -nocomplain -directory $globname -type l *] |
---|
| 863 | } msg] $msg] |
---|
| 864 | }]} { |
---|
| 865 | cd $dir |
---|
| 866 | } |
---|
| 867 | file delete [file join $globname link] |
---|
| 868 | set ret |
---|
| 869 | } [list 0 [list [file join $globname link]]] |
---|
| 870 | test filename-11.17.8 {Tcl_GlobCmd: broken link and glob -l} {symbolicLinkFile} { |
---|
| 871 | set dir [pwd] |
---|
| 872 | set ret "error in test" |
---|
| 873 | if {[catch { |
---|
| 874 | cd $globname |
---|
| 875 | close [open "nonexistent" w] |
---|
| 876 | file link -symbolic link nonexistent |
---|
| 877 | file delete nonexistent |
---|
| 878 | cd $dir |
---|
| 879 | set ret [list [catch { |
---|
| 880 | lsort [glob -nocomplain -directory $globname -type l *] |
---|
| 881 | } msg] $msg] |
---|
| 882 | }]} { |
---|
| 883 | cd $dir |
---|
| 884 | } |
---|
| 885 | file delete [file join $globname link] |
---|
| 886 | set ret |
---|
| 887 | } [list 0 [list [file join $globname link]]] |
---|
| 888 | test filename-11.18 {Tcl_GlobCmd} {unix} { |
---|
| 889 | list [catch {lsort [glob -path $globname/ *]} msg] $msg |
---|
| 890 | } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ |
---|
| 891 | [file join $globname a3]\ |
---|
| 892 | [file join $globname "weird name.c"]\ |
---|
| 893 | [file join $globname x,z1.c]\ |
---|
| 894 | [file join $globname x1.c]\ |
---|
| 895 | [file join $globname y1.c] [file join $globname z1.c]]]] |
---|
| 896 | test filename-11.18.1 {Tcl_GlobCmd} {win} { |
---|
| 897 | list [catch {lsort [glob -path $globname/ *]} msg] $msg |
---|
| 898 | } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ |
---|
| 899 | [file join $globname .1]\ |
---|
| 900 | [file join $globname a3]\ |
---|
| 901 | [file join $globname "weird name.c"]\ |
---|
| 902 | [file join $globname x,z1.c]\ |
---|
| 903 | [file join $globname x1.c]\ |
---|
| 904 | [file join $globname y1.c] [file join $globname z1.c]]]] |
---|
| 905 | test filename-11.19 {Tcl_GlobCmd} {unix} { |
---|
| 906 | list [catch {lsort [glob -join -path \ |
---|
| 907 | [string range $globname 0 5] * *]} msg] $msg |
---|
| 908 | } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ |
---|
| 909 | [file join $globname a3]\ |
---|
| 910 | [file join $globname "weird name.c"]\ |
---|
| 911 | [file join $globname x,z1.c]\ |
---|
| 912 | [file join $globname x1.c]\ |
---|
| 913 | [file join $globname y1.c] [file join $globname z1.c]]]] |
---|
| 914 | test filename-11.19.1 {Tcl_GlobCmd} {win} { |
---|
| 915 | list [catch {lsort [glob -join -path \ |
---|
| 916 | [string range $globname 0 5] * *]} msg] $msg |
---|
| 917 | } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ |
---|
| 918 | [file join $globname .1]\ |
---|
| 919 | [file join $globname a3]\ |
---|
| 920 | [file join $globname "weird name.c"]\ |
---|
| 921 | [file join $globname x,z1.c]\ |
---|
| 922 | [file join $globname x1.c]\ |
---|
| 923 | [file join $globname y1.c] [file join $globname z1.c]]]] |
---|
| 924 | test filename-11.20 {Tcl_GlobCmd} { |
---|
| 925 | list [catch {lsort [glob -type d -dir $globname *]} msg] $msg |
---|
| 926 | } [list 0 [lsort [list [file join $globname a1]\ |
---|
| 927 | [file join $globname a2]\ |
---|
| 928 | [file join $globname a3]]]] |
---|
| 929 | test filename-11.21 {Tcl_GlobCmd} { |
---|
| 930 | list [catch {lsort [glob -type d -path $globname *]} msg] $msg |
---|
| 931 | } [list 0 [lsort [list $globname]]] |
---|
| 932 | |
---|
| 933 | test filename-11.21.1 {Tcl_GlobCmd} { |
---|
| 934 | close [open {[tcl].testremains} w] |
---|
| 935 | set res [list [catch {lsort [glob -path {[tcl]} *]} msg] $msg] |
---|
| 936 | file delete -force {[tcl].testremains} |
---|
| 937 | set res |
---|
| 938 | } [list 0 {{[tcl].testremains}}] |
---|
| 939 | |
---|
| 940 | # Get rid of file/dir if it exists, since it will have |
---|
| 941 | # been left behind by a previous failed run. |
---|
| 942 | if {[file exists $horribleglobname]} { |
---|
| 943 | file delete -force $horribleglobname |
---|
| 944 | } |
---|
| 945 | file rename globTest $horribleglobname |
---|
| 946 | set globname $horribleglobname |
---|
| 947 | |
---|
| 948 | test filename-11.22 {Tcl_GlobCmd} {unix} { |
---|
| 949 | list [catch {lsort [glob -dir $globname *]} msg] $msg |
---|
| 950 | } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ |
---|
| 951 | [file join $globname a3]\ |
---|
| 952 | [file join $globname "weird name.c"]\ |
---|
| 953 | [file join $globname x,z1.c]\ |
---|
| 954 | [file join $globname x1.c]\ |
---|
| 955 | [file join $globname y1.c] [file join $globname z1.c]]]] |
---|
| 956 | test filename-11.22.1 {Tcl_GlobCmd} {win} { |
---|
| 957 | list [catch {lsort [glob -dir $globname *]} msg] $msg |
---|
| 958 | } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ |
---|
| 959 | [file join $globname .1]\ |
---|
| 960 | [file join $globname a3]\ |
---|
| 961 | [file join $globname "weird name.c"]\ |
---|
| 962 | [file join $globname x,z1.c]\ |
---|
| 963 | [file join $globname x1.c]\ |
---|
| 964 | [file join $globname y1.c] [file join $globname z1.c]]]] |
---|
| 965 | test filename-11.23 {Tcl_GlobCmd} {unix} { |
---|
| 966 | list [catch {lsort [glob -path $globname/ *]} msg] $msg |
---|
| 967 | } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ |
---|
| 968 | [file join $globname a3]\ |
---|
| 969 | [file join $globname "weird name.c"]\ |
---|
| 970 | [file join $globname x,z1.c]\ |
---|
| 971 | [file join $globname x1.c]\ |
---|
| 972 | [file join $globname y1.c] [file join $globname z1.c]]]] |
---|
| 973 | test filename-11.23.1 {Tcl_GlobCmd} {win} { |
---|
| 974 | list [catch {lsort [glob -path $globname/ *]} msg] $msg |
---|
| 975 | } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ |
---|
| 976 | [file join $globname .1]\ |
---|
| 977 | [file join $globname a3]\ |
---|
| 978 | [file join $globname "weird name.c"]\ |
---|
| 979 | [file join $globname x,z1.c]\ |
---|
| 980 | [file join $globname x1.c]\ |
---|
| 981 | [file join $globname y1.c] [file join $globname z1.c]]]] |
---|
| 982 | test filename-11.24 {Tcl_GlobCmd} {unix} { |
---|
| 983 | list [catch {lsort [glob -join -path \ |
---|
| 984 | [string range $globname 0 5] * *]} msg] $msg |
---|
| 985 | } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ |
---|
| 986 | [file join $globname a3]\ |
---|
| 987 | [file join $globname "weird name.c"]\ |
---|
| 988 | [file join $globname x,z1.c]\ |
---|
| 989 | [file join $globname x1.c]\ |
---|
| 990 | [file join $globname y1.c] [file join $globname z1.c]]]] |
---|
| 991 | test filename-11.24.1 {Tcl_GlobCmd} {win} { |
---|
| 992 | list [catch {lsort [glob -join -path \ |
---|
| 993 | [string range $globname 0 5] * *]} msg] $msg |
---|
| 994 | } [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\ |
---|
| 995 | [file join $globname .1]\ |
---|
| 996 | [file join $globname a3]\ |
---|
| 997 | [file join $globname "weird name.c"]\ |
---|
| 998 | [file join $globname x,z1.c]\ |
---|
| 999 | [file join $globname x1.c]\ |
---|
| 1000 | [file join $globname y1.c] [file join $globname z1.c]]]] |
---|
| 1001 | test filename-11.25 {Tcl_GlobCmd} { |
---|
| 1002 | list [catch {lsort [glob -type d -dir $globname *]} msg] $msg |
---|
| 1003 | } [list 0 [lsort [list [file join $globname a1]\ |
---|
| 1004 | [file join $globname a2]\ |
---|
| 1005 | [file join $globname a3]]]] |
---|
| 1006 | test filename-11.25.1 {Tcl_GlobCmd} { |
---|
| 1007 | list [catch {lsort [glob -type {d r} -dir $globname *]} msg] $msg |
---|
| 1008 | } [list 0 [lsort [list [file join $globname a1]\ |
---|
| 1009 | [file join $globname a2]\ |
---|
| 1010 | [file join $globname a3]]]] |
---|
| 1011 | test filename-11.25.2 {Tcl_GlobCmd} { |
---|
| 1012 | list [catch {lsort [glob -type {d r w} -dir $globname *]} msg] $msg |
---|
| 1013 | } [list 0 [lsort [list [file join $globname a1]\ |
---|
| 1014 | [file join $globname a2]\ |
---|
| 1015 | [file join $globname a3]]]] |
---|
| 1016 | test filename-11.26 {Tcl_GlobCmd} { |
---|
| 1017 | list [catch {glob -type d -path $globname *} msg] $msg |
---|
| 1018 | } [list 0 [list $globname]] |
---|
| 1019 | test filename-11.27 {Tcl_GlobCmd} { |
---|
| 1020 | list [catch {glob -types abcde *} msg] $msg |
---|
| 1021 | } {1 {bad argument to "-types": abcde}} |
---|
| 1022 | test filename-11.28 {Tcl_GlobCmd} { |
---|
| 1023 | list [catch {glob -types z *} msg] $msg |
---|
| 1024 | } {1 {bad argument to "-types": z}} |
---|
| 1025 | test filename-11.29 {Tcl_GlobCmd} { |
---|
| 1026 | list [catch {glob -types {abcd efgh} *} msg] $msg |
---|
| 1027 | } {1 {only one MacOS type or creator argument to "-types" allowed}} |
---|
| 1028 | test filename-11.30 {Tcl_GlobCmd} { |
---|
| 1029 | list [catch {glob -types {{macintosh type TEXT} \ |
---|
| 1030 | {macintosh creator ALFA} efgh} *} msg] $msg |
---|
| 1031 | } {1 {only one MacOS type or creator argument to "-types" allowed}} |
---|
| 1032 | test filename-11.31 {Tcl_GlobCmd} { |
---|
| 1033 | list [catch {glob -types} msg] $msg |
---|
| 1034 | } {1 {missing argument to "-types"}} |
---|
| 1035 | test filename-11.32 {Tcl_GlobCmd} { |
---|
| 1036 | list [catch {glob -path hello -dir hello *} msg] $msg |
---|
| 1037 | } {1 {"-directory" cannot be used with "-path"}} |
---|
| 1038 | test filename-11.33 {Tcl_GlobCmd} { |
---|
| 1039 | list [catch {glob -path} msg] $msg |
---|
| 1040 | } {1 {missing argument to "-path"}} |
---|
| 1041 | test filename-11.34 {Tcl_GlobCmd} { |
---|
| 1042 | list [catch {glob -direct} msg] $msg |
---|
| 1043 | } {1 {missing argument to "-directory"}} |
---|
| 1044 | test filename-11.35 {Tcl_GlobCmd} { |
---|
| 1045 | list [catch {glob -paths *} msg] $msg |
---|
| 1046 | } {1 {bad option "-paths": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}} |
---|
| 1047 | # Test '-tails' flag to glob. |
---|
| 1048 | test filename-11.36 {Tcl_GlobCmd} { |
---|
| 1049 | list [catch {glob -tails *} msg] $msg |
---|
| 1050 | } {1 {"-tails" must be used with either "-directory" or "-path"}} |
---|
| 1051 | test filename-11.37 {Tcl_GlobCmd} { |
---|
| 1052 | list [catch {glob -type d -tails -path $globname *} msg] $msg |
---|
| 1053 | } [list 0 [list $globname]] |
---|
| 1054 | test filename-11.38 {Tcl_GlobCmd} { |
---|
| 1055 | list [catch {glob -tails -path $globname *} msg] $msg |
---|
| 1056 | } [list 0 [list $globname]] |
---|
| 1057 | test filename-11.39 {Tcl_GlobCmd} { |
---|
| 1058 | list [catch {glob -tails -join -path $globname *} msg] $msg |
---|
| 1059 | } [list 0 [list $globname]] |
---|
| 1060 | test filename-11.40 {Tcl_GlobCmd} { |
---|
| 1061 | expr {[glob -dir [pwd] -tails *] == [glob *]} |
---|
| 1062 | } {1} |
---|
| 1063 | test filename-11.41 {Tcl_GlobCmd} { |
---|
| 1064 | expr {[glob -dir [pwd] -tails *] != [glob -dir [pwd] *]} |
---|
| 1065 | } {1} |
---|
| 1066 | test filename-11.42 {Tcl_GlobCmd} { |
---|
| 1067 | set res [list] |
---|
| 1068 | foreach f [glob -dir [pwd] *] { |
---|
| 1069 | lappend res [file tail $f] |
---|
| 1070 | } |
---|
| 1071 | expr {$res == [glob *]} |
---|
| 1072 | } {1} |
---|
| 1073 | test filename-11.43 {Tcl_GlobCmd} { |
---|
| 1074 | list [catch {glob -t *} msg] $msg |
---|
| 1075 | } {1 {ambiguous option "-t": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}} |
---|
| 1076 | test filename-11.44 {Tcl_GlobCmd} { |
---|
| 1077 | list [catch {glob -tails -path hello -directory hello *} msg] $msg |
---|
| 1078 | } {1 {"-directory" cannot be used with "-path"}} |
---|
| 1079 | test filename-11.45 {Tcl_GlobCmd on root volume} { |
---|
| 1080 | set res1 "" |
---|
| 1081 | set res2 "" |
---|
| 1082 | catch { |
---|
| 1083 | set res1 [glob -dir [lindex [file volumes] 0] -tails *] |
---|
| 1084 | } |
---|
| 1085 | catch { |
---|
| 1086 | set tmpd [pwd] |
---|
| 1087 | cd [lindex [file volumes] 0] |
---|
| 1088 | set res2 [glob *] |
---|
| 1089 | cd $tmpd |
---|
| 1090 | } |
---|
| 1091 | set res [expr {$res1 == $res2}] |
---|
| 1092 | if {!$res} { |
---|
| 1093 | lappend res $res1 $res2 |
---|
| 1094 | } |
---|
| 1095 | set res |
---|
| 1096 | } {1} |
---|
| 1097 | test filename-11.46 {Tcl_GlobCmd} { |
---|
| 1098 | list [catch {glob -types abcde -dir foo *} msg] $msg |
---|
| 1099 | } {1 {bad argument to "-types": abcde}} |
---|
| 1100 | test filename-11.47 {Tcl_GlobCmd} { |
---|
| 1101 | list [catch {glob -types abcde -path foo *} msg] $msg |
---|
| 1102 | } {1 {bad argument to "-types": abcde}} |
---|
| 1103 | test filename-11.48 {Tcl_GlobCmd} { |
---|
| 1104 | list [catch {glob -types abcde -dir foo -join * *} msg] $msg |
---|
| 1105 | } {1 {bad argument to "-types": abcde}} |
---|
| 1106 | test filename-11.49 {Tcl_GlobCmd} { |
---|
| 1107 | list [catch {glob -types abcde -path foo -join * *} msg] $msg |
---|
| 1108 | } {1 {bad argument to "-types": abcde}} |
---|
| 1109 | |
---|
| 1110 | file rename $horribleglobname globTest |
---|
| 1111 | set globname globTest |
---|
| 1112 | unset horribleglobname |
---|
| 1113 | |
---|
| 1114 | test filename-12.1 {simple globbing} {unixOrPc} { |
---|
| 1115 | list [catch {glob {}} msg] $msg |
---|
| 1116 | } {0 .} |
---|
| 1117 | test filename-12.1.1 {simple globbing} {unixOrPc} { |
---|
| 1118 | list [catch {glob -types f {}} msg] $msg |
---|
| 1119 | } {1 {no files matched glob pattern ""}} |
---|
| 1120 | test filename-12.1.2 {simple globbing} {unixOrPc} { |
---|
| 1121 | list [catch {glob -types d {}} msg] $msg |
---|
| 1122 | } {0 .} |
---|
| 1123 | test filename-12.1.3 {simple globbing} {unix} { |
---|
| 1124 | list [catch {glob -types hidden {}} msg] $msg |
---|
| 1125 | } {0 .} |
---|
| 1126 | test filename-12.1.4 {simple globbing} {win} { |
---|
| 1127 | list [catch {glob -types hidden {}} msg] $msg |
---|
| 1128 | } {1 {no files matched glob pattern ""}} |
---|
| 1129 | test filename-12.1.5 {simple globbing} {win} { |
---|
| 1130 | list [catch {glob -types hidden c:/} msg] $msg |
---|
| 1131 | } {1 {no files matched glob pattern "c:/"}} |
---|
| 1132 | test filename-12.1.6 {simple globbing} {win} { |
---|
| 1133 | list [catch {glob c:/} msg] $msg |
---|
| 1134 | } {0 c:/} |
---|
| 1135 | test filename-12.3 {simple globbing} { |
---|
| 1136 | list [catch {glob -nocomplain \{a1,a2\}} msg] $msg |
---|
| 1137 | } {0 {}} |
---|
| 1138 | |
---|
| 1139 | set globPreResult globTest/ |
---|
| 1140 | set x1 x1.c |
---|
| 1141 | set y1 y1.c |
---|
| 1142 | test filename-12.4 {simple globbing} {unixOrPc} { |
---|
| 1143 | lsort [glob globTest/x1.c globTest/y1.c globTest/foo] |
---|
| 1144 | } "$globPreResult$x1 $globPreResult$y1" |
---|
| 1145 | test filename-12.5 {simple globbing} { |
---|
| 1146 | list [catch {glob globTest\\/x1.c} msg] $msg |
---|
| 1147 | } "0 $globPreResult$x1" |
---|
| 1148 | test filename-12.6 {simple globbing} { |
---|
| 1149 | list [catch {glob globTest\\/\\x1.c} msg] $msg |
---|
| 1150 | } "0 $globPreResult$x1" |
---|
| 1151 | test filename-12.7 {globbing at filesystem root} {unix} { |
---|
| 1152 | set res1 [glob -nocomplain /*] |
---|
| 1153 | set res2 [glob -path / *] |
---|
| 1154 | set equal [string equal $res1 $res2] |
---|
| 1155 | if {!$equal} { |
---|
| 1156 | lappend equal "not equal" $res1 $res2 |
---|
| 1157 | } |
---|
| 1158 | set equal |
---|
| 1159 | } {1} |
---|
| 1160 | test filename-12.8 {globbing at filesystem root} {unix} { |
---|
| 1161 | set dir [lindex [glob -type d /*] 0] |
---|
| 1162 | set first [string range $dir 0 1] |
---|
| 1163 | set res1 [glob -nocomplain ${first}*] |
---|
| 1164 | set res2 [glob -path $first *] |
---|
| 1165 | set equal [string equal $res1 $res2] |
---|
| 1166 | if {!$equal} { |
---|
| 1167 | lappend equal "not equal" $res1 $res2 |
---|
| 1168 | } |
---|
| 1169 | set equal |
---|
| 1170 | } {1} |
---|
| 1171 | test filename-12.9 {globbing at filesystem root} {win} { |
---|
| 1172 | # Can't grab just anything from 'file volumes' because we need a dir |
---|
| 1173 | # that has subdirs - assume that C:/ exists across Windows machines. |
---|
| 1174 | set dir [lindex [glob -type d C:/*] 0] |
---|
| 1175 | set first [string range $dir 0 3] |
---|
| 1176 | set res1 [glob -nocomplain ${first}*] |
---|
| 1177 | set res2 [glob -path $first *] |
---|
| 1178 | set equal [string equal $res1 $res2] |
---|
| 1179 | if {!$equal} { |
---|
| 1180 | lappend equal "not equal" $res1 $res2 |
---|
| 1181 | } |
---|
| 1182 | set equal |
---|
| 1183 | } {1} |
---|
| 1184 | |
---|
| 1185 | test filename-12.10 {globbing with volume relative paths} {win} { |
---|
| 1186 | set dir [lindex [glob -type d C:/*] 0] |
---|
| 1187 | set pwd [pwd] |
---|
| 1188 | cd C:/ |
---|
| 1189 | set res1 [glob -nocomplain [string range $dir 2 end]] |
---|
| 1190 | cd $pwd |
---|
| 1191 | set res2 [list $dir] |
---|
| 1192 | set equal [string equal $res1 $res2] |
---|
| 1193 | if {!$equal} { |
---|
| 1194 | lappend equal "not equal" $res1 $res2 |
---|
| 1195 | } |
---|
| 1196 | set equal |
---|
| 1197 | } {1} |
---|
| 1198 | |
---|
| 1199 | test filename-13.1 {globbing with brace substitution} { |
---|
| 1200 | list [catch {glob globTest/\{\}} msg] $msg |
---|
| 1201 | } "0 $globPreResult" |
---|
| 1202 | test filename-13.2 {globbing with brace substitution} { |
---|
| 1203 | list [catch {glob globTest/\{} msg] $msg |
---|
| 1204 | } {1 {unmatched open-brace in file name}} |
---|
| 1205 | test filename-13.3 {globbing with brace substitution} { |
---|
| 1206 | list [catch {glob globTest/\{\\\}} msg] $msg |
---|
| 1207 | } {1 {unmatched open-brace in file name}} |
---|
| 1208 | test filename-13.4 {globbing with brace substitution} { |
---|
| 1209 | list [catch {glob globTest/\{\\} msg] $msg |
---|
| 1210 | } {1 {unmatched open-brace in file name}} |
---|
| 1211 | test filename-13.5 {globbing with brace substitution} { |
---|
| 1212 | list [catch {glob globTest/\}} msg] $msg |
---|
| 1213 | } {1 {unmatched close-brace in file name}} |
---|
| 1214 | test filename-13.6 {globbing with brace substitution} { |
---|
| 1215 | list [catch {glob globTest/\{\}x1.c} msg] $msg |
---|
| 1216 | } "0 $globPreResult$x1" |
---|
| 1217 | test filename-13.7 {globbing with brace substitution} { |
---|
| 1218 | list [catch {glob globTest/\{x\}1.c} msg] $msg |
---|
| 1219 | } "0 $globPreResult$x1" |
---|
| 1220 | test filename-13.8 {globbing with brace substitution} { |
---|
| 1221 | list [catch {glob globTest/\{x\{\}\}1.c} msg] $msg |
---|
| 1222 | } "0 $globPreResult$x1" |
---|
| 1223 | test filename-13.9 {globbing with brace substitution} { |
---|
| 1224 | list [lsort [catch {glob globTest/\{x,y\}1.c} msg]] $msg |
---|
| 1225 | } [list 0 [list $globPreResult$x1 $globPreResult$y1]] |
---|
| 1226 | test filename-13.10 {globbing with brace substitution} { |
---|
| 1227 | list [lsort [catch {glob globTest/\{x,,y\}1.c} msg]] $msg |
---|
| 1228 | } [list 0 [list $globPreResult$x1 $globPreResult$y1]] |
---|
| 1229 | test filename-13.11 {globbing with brace substitution} {unixOrPc} { |
---|
| 1230 | list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg |
---|
| 1231 | } {0 {globTest/x1.c globTest/x,z1.c globTest/z1.c}} |
---|
| 1232 | test filename-13.13 {globbing with brace substitution} { |
---|
| 1233 | lsort [glob globTest/{a,b,x,y}1.c] |
---|
| 1234 | } [list $globPreResult$x1 $globPreResult$y1] |
---|
| 1235 | test filename-13.14 {globbing with brace substitution} {unixOrPc} { |
---|
| 1236 | lsort [glob {globTest/{x1,y2,weird name}.c}] |
---|
| 1237 | } {{globTest/weird name.c} globTest/x1.c} |
---|
| 1238 | test filename-13.16 {globbing with brace substitution} {unixOrPc} { |
---|
| 1239 | lsort [glob globTest/{x1.c,a1/*}] |
---|
| 1240 | } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c} |
---|
| 1241 | test filename-13.18 {globbing with brace substitution} {unixOrPc} { |
---|
| 1242 | lsort [glob globTest/{x1.c,{a},a1/*}] |
---|
| 1243 | } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c} |
---|
| 1244 | test filename-13.20 {globbing with brace substitution} {unixOrPc} { |
---|
| 1245 | lsort [glob globTest/{a,x}1/*/{x,y}*] |
---|
| 1246 | } {globTest/a1/b1/x2.c globTest/a1/b2/y2.c} |
---|
| 1247 | test filename-13.22 {globbing with brace substitution} { |
---|
| 1248 | list [catch {glob globTest/\{a,x\}1/*/\{} msg] $msg |
---|
| 1249 | } {1 {unmatched open-brace in file name}} |
---|
| 1250 | |
---|
| 1251 | test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} { |
---|
| 1252 | lsort [glob glo*/*.c] |
---|
| 1253 | } {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} |
---|
| 1254 | test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} { |
---|
| 1255 | lsort [glob globTest/?1.c] |
---|
| 1256 | } {globTest/x1.c globTest/y1.c globTest/z1.c} |
---|
| 1257 | |
---|
| 1258 | # The current directory could be anywhere; do this to stop spurious matches |
---|
| 1259 | file mkdir globTestContext |
---|
| 1260 | file rename globTest [file join globTestContext globTest] |
---|
| 1261 | set savepwd [pwd] |
---|
| 1262 | cd globTestContext |
---|
| 1263 | |
---|
| 1264 | test filename-14.5 {asterisks, question marks, and brackets} {unixOrPc} { |
---|
| 1265 | lsort [glob */*/*/*.c] |
---|
| 1266 | } {globTest/a1/b1/x2.c globTest/a1/b2/y2.c} |
---|
| 1267 | |
---|
| 1268 | # Reset to where we were |
---|
| 1269 | cd $savepwd |
---|
| 1270 | file rename [file join globTestContext globTest] globTest |
---|
| 1271 | file delete globTestContext |
---|
| 1272 | |
---|
| 1273 | test filename-14.7 {asterisks, question marks, and brackets} {unix} { |
---|
| 1274 | lsort [glob globTest/*] |
---|
| 1275 | } {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c} |
---|
| 1276 | test filename-14.7.1 {asterisks, question marks, and brackets} {win} { |
---|
| 1277 | lsort [glob globTest/*] |
---|
| 1278 | } {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} |
---|
| 1279 | test filename-14.9 {asterisks, question marks, and brackets} {unixOrPc} { |
---|
| 1280 | lsort [glob globTest/.*] |
---|
| 1281 | } {globTest/. globTest/.. globTest/.1} |
---|
| 1282 | test filename-14.11 {asterisks, question marks, and brackets} {unixOrPc} { |
---|
| 1283 | lsort [glob globTest/*/*] |
---|
| 1284 | } {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3} |
---|
| 1285 | test filename-14.13 {asterisks, question marks, and brackets} {unixOrPc} { |
---|
| 1286 | lsort [glob {globTest/[xyab]1.*}] |
---|
| 1287 | } {globTest/x1.c globTest/y1.c} |
---|
| 1288 | test filename-14.15 {asterisks, question marks, and brackets} {unixOrPc} { |
---|
| 1289 | lsort [glob globTest/*/] |
---|
| 1290 | } {globTest/a1/ globTest/a2/ globTest/a3/} |
---|
| 1291 | test filename-14.17 {asterisks, question marks, and brackets} { |
---|
| 1292 | global env |
---|
| 1293 | set temp $env(HOME) |
---|
| 1294 | set env(HOME) [file join $env(HOME) globTest] |
---|
| 1295 | set result [list [catch {glob ~/z*} msg] $msg] |
---|
| 1296 | set env(HOME) $temp |
---|
| 1297 | set result |
---|
| 1298 | } [list 0 [list [file join $env(HOME) globTest z1.c]]] |
---|
| 1299 | test filename-14.18 {asterisks, question marks, and brackets} {unixOrPc} { |
---|
| 1300 | list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg |
---|
| 1301 | } {0 {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}} |
---|
| 1302 | test filename-14.20 {asterisks, question marks, and brackets} { |
---|
| 1303 | list [catch {glob -nocomplain goo/*} msg] $msg |
---|
| 1304 | } {0 {}} |
---|
| 1305 | test filename-14.21 {asterisks, question marks, and brackets} { |
---|
| 1306 | list [catch {glob globTest/*/gorp} msg] $msg |
---|
| 1307 | } {1 {no files matched glob pattern "globTest/*/gorp"}} |
---|
| 1308 | test filename-14.22 {asterisks, question marks, and brackets} { |
---|
| 1309 | list [catch {glob goo/* x*z foo?q} msg] $msg |
---|
| 1310 | } {1 {no files matched glob patterns "goo/* x*z foo?q"}} |
---|
| 1311 | test filename-14.23 {slash globbing} {unix} { |
---|
| 1312 | glob / |
---|
| 1313 | } / |
---|
| 1314 | test filename-14.23.2 {slash globbing} {win} { |
---|
| 1315 | glob / |
---|
| 1316 | } [file norm /] |
---|
| 1317 | test filename-14.24 {slash globbing} {win} { |
---|
| 1318 | glob {\\} |
---|
| 1319 | } [file norm /] |
---|
| 1320 | test filename-14.25 {type specific globbing} {unix} { |
---|
| 1321 | list [catch {lsort [glob -dir globTest -types f *]} msg] $msg |
---|
| 1322 | } [list 0 [lsort [list \ |
---|
| 1323 | [file join $globname "weird name.c"]\ |
---|
| 1324 | [file join $globname x,z1.c]\ |
---|
| 1325 | [file join $globname x1.c]\ |
---|
| 1326 | [file join $globname y1.c] [file join $globname z1.c]]]] |
---|
| 1327 | test filename-14.25.1 {type specific globbing} {win} { |
---|
| 1328 | list [catch {lsort [glob -dir globTest -types f *]} msg] $msg |
---|
| 1329 | } [list 0 [lsort [list \ |
---|
| 1330 | [file join $globname .1]\ |
---|
| 1331 | [file join $globname "weird name.c"]\ |
---|
| 1332 | [file join $globname x,z1.c]\ |
---|
| 1333 | [file join $globname x1.c]\ |
---|
| 1334 | [file join $globname y1.c] [file join $globname z1.c]]]] |
---|
| 1335 | test filename-14.26 {type specific globbing} { |
---|
| 1336 | list [catch {glob -nocomplain -dir globTest -types {readonly} *} msg] $msg |
---|
| 1337 | } [list 0 {}] |
---|
| 1338 | |
---|
| 1339 | unset globname |
---|
| 1340 | |
---|
| 1341 | # The following tests are only valid for Unix systems. |
---|
| 1342 | # On some systems, like AFS, "000" protection doesn't prevent |
---|
| 1343 | # access by owner, so the following test is not portable. |
---|
| 1344 | |
---|
| 1345 | catch {file attributes globTest/a1 -permissions 0000} |
---|
| 1346 | test filename-15.1 {unix specific globbing} {unix nonPortable} { |
---|
| 1347 | string tolower [list [catch {glob globTest/a1/*} msg] $msg $errorCode] |
---|
| 1348 | } {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}} |
---|
| 1349 | test filename-15.2 {unix specific no complain: no errors} {unix nonPortable} { |
---|
| 1350 | glob -nocomplain globTest/a1/* |
---|
| 1351 | } {} |
---|
| 1352 | test filename-15.3 {unix specific no complain: no errors, good result} \ |
---|
| 1353 | {unix nonPortable} { |
---|
| 1354 | # test fails because if an error occur , the interp's result |
---|
| 1355 | # is reset... |
---|
| 1356 | glob -nocomplain globTest/a2 globTest/a1/* globTest/a3 |
---|
| 1357 | } {globTest/a2 globTest/a3} |
---|
| 1358 | |
---|
| 1359 | catch {file attributes globTest/a1 -permissions 0755} |
---|
| 1360 | test filename-15.4 {unix specific no complain: no errors, good result} \ |
---|
| 1361 | {unix nonPortable} { |
---|
| 1362 | # test fails because if an error occurs, the interp's result |
---|
| 1363 | # is reset... or you don't run at scriptics where the |
---|
| 1364 | # outser and welch users exists |
---|
| 1365 | glob -nocomplain ~ouster ~foo ~welch |
---|
| 1366 | } {/home/ouster /home/welch} |
---|
| 1367 | test filename-15.4.1 {no complain: errors, sequencing} { |
---|
| 1368 | # test used to fail because if an error occurs, the interp's result |
---|
| 1369 | # is reset... But, the sequence means we throw a different error |
---|
| 1370 | # first. |
---|
| 1371 | concat \ |
---|
| 1372 | [list [catch {glob -nocomplain ~wontexist ~blahxyz ~} res1] $res1] \ |
---|
| 1373 | [list [catch {glob -nocomplain ~ ~blahxyz ~wontexist} res2] $res2] |
---|
| 1374 | } {1 {user "wontexist" doesn't exist} 1 {user "blahxyz" doesn't exist}} |
---|
| 1375 | test filename-15.4.2 {no complain: errors, sequencing} { |
---|
| 1376 | # test used to fail because if an error occurs, the interp's result |
---|
| 1377 | # is reset... |
---|
| 1378 | string equal \ |
---|
| 1379 | [list [catch {glob -nocomplain ~wontexist *} res1] $res1] \ |
---|
| 1380 | [list [catch {glob -nocomplain * ~wontexist} res2] $res2] |
---|
| 1381 | } {1} |
---|
| 1382 | test filename-15.5 {unix specific globbing} {unix nonPortable} { |
---|
| 1383 | glob ~ouster/.csh* |
---|
| 1384 | } "/home/ouster/.cshrc" |
---|
| 1385 | catch {close [open globTest/odd\\\[\]*?\{\}name w]} |
---|
| 1386 | test filename-15.6 {unix specific globbing} {unix} { |
---|
| 1387 | global env |
---|
| 1388 | set temp $env(HOME) |
---|
| 1389 | set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name |
---|
| 1390 | set result [list [catch {glob ~} msg] $msg] |
---|
| 1391 | set env(HOME) $temp |
---|
| 1392 | set result |
---|
| 1393 | } [list 0 [list [lindex [glob ~] 0]/globTest/odd\\\[\]*?\{\}name]] |
---|
| 1394 | catch {file delete -force globTest/odd\\\[\]*?\{\}name} |
---|
| 1395 | test filename-15.7 {win specific globbing} {win} { |
---|
| 1396 | if {[string index [glob ~] end] == "/"} { |
---|
| 1397 | set res "glob ~ is [glob ~] but shouldn't end in a separator" |
---|
| 1398 | } else { |
---|
| 1399 | set res "ok" |
---|
| 1400 | } |
---|
| 1401 | } {ok} |
---|
| 1402 | test filename-15.8 {win and unix specific globbing} {unixOrWin} { |
---|
| 1403 | global env |
---|
| 1404 | set temp $env(HOME) |
---|
| 1405 | catch {close [open $env(HOME)/globTest/anyname w]} err |
---|
| 1406 | set env(HOME) $env(HOME)/globTest/anyname |
---|
| 1407 | set result [list [catch {glob ~} msg] $msg] |
---|
| 1408 | set env(HOME) $temp |
---|
| 1409 | catch {file delete -force $env(HOME)/globTest/anyname} |
---|
| 1410 | set result |
---|
| 1411 | } [list 0 [list [lindex [glob ~] 0]/globTest/anyname]] |
---|
| 1412 | |
---|
| 1413 | # The following tests are only valid for Windows systems. |
---|
| 1414 | set oldDir [pwd] |
---|
| 1415 | if {[testConstraint win]} { |
---|
| 1416 | cd c:/ |
---|
| 1417 | file delete -force globTest |
---|
| 1418 | file mkdir globTest |
---|
| 1419 | close [open globTest/x1.BAT w] |
---|
| 1420 | close [open globTest/y1.Bat w] |
---|
| 1421 | close [open globTest/z1.bat w] |
---|
| 1422 | } |
---|
| 1423 | |
---|
| 1424 | test filename-16.1 {windows specific globbing} {win} { |
---|
| 1425 | lsort [glob globTest/*.bat] |
---|
| 1426 | } {globTest/x1.BAT globTest/y1.Bat globTest/z1.bat} |
---|
| 1427 | test filename-16.2 {windows specific globbing} {win} { |
---|
| 1428 | list [catch {glob c:} res] $res |
---|
| 1429 | } {0 c:} |
---|
| 1430 | test filename-16.2.1 {windows specific globbing} {win} { |
---|
| 1431 | set dir [pwd] |
---|
| 1432 | cd C:/ |
---|
| 1433 | set res [list [catch {glob c:} err] $err] |
---|
| 1434 | cd $dir |
---|
| 1435 | set res |
---|
| 1436 | } {0 c:} |
---|
| 1437 | test filename-16.3 {windows specific globbing} {win} { |
---|
| 1438 | glob -nocomplain c:\\\\ |
---|
| 1439 | } c:/ |
---|
| 1440 | test filename-16.4 {windows specific globbing} {win} { |
---|
| 1441 | glob -nocomplain c:/ |
---|
| 1442 | } c:/ |
---|
| 1443 | test filename-16.5 {windows specific globbing} {win} { |
---|
| 1444 | glob -nocomplain c:*bTest |
---|
| 1445 | } c:globTest |
---|
| 1446 | test filename-16.6 {windows specific globbing} {win} { |
---|
| 1447 | glob -nocomplain c:\\\\*bTest |
---|
| 1448 | } c:/globTest |
---|
| 1449 | test filename-16.7 {windows specific globbing} {win} { |
---|
| 1450 | glob -nocomplain c:/*bTest |
---|
| 1451 | } c:/globTest |
---|
| 1452 | test filename-16.8 {windows specific globbing} {win} { |
---|
| 1453 | lsort [glob -nocomplain c:globTest/*.bat] |
---|
| 1454 | } {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat} |
---|
| 1455 | test filename-16.9 {windows specific globbing} {win} { |
---|
| 1456 | lsort [glob -nocomplain c:/globTest/*.bat] |
---|
| 1457 | } {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat} |
---|
| 1458 | test filename-16.10 {windows specific globbing} {win} { |
---|
| 1459 | lsort [glob -nocomplain c:globTest\\\\*.bat] |
---|
| 1460 | } {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat} |
---|
| 1461 | test filename-16.11 {windows specific globbing} {win} { |
---|
| 1462 | lsort [glob -nocomplain c:\\\\globTest\\\\*.bat] |
---|
| 1463 | } {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat} |
---|
| 1464 | |
---|
| 1465 | # some tests require a shared C drive |
---|
| 1466 | |
---|
| 1467 | if {[testConstraint win]} { |
---|
| 1468 | testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}] |
---|
| 1469 | } |
---|
| 1470 | |
---|
| 1471 | test filename-16.12 {windows specific globbing} {win sharedCdrive} { |
---|
| 1472 | cd //[info hostname]/c |
---|
| 1473 | glob //[info hostname]/c/*Test |
---|
| 1474 | } //[info hostname]/c/globTest |
---|
| 1475 | test filename-16.13 {windows specific globbing} {win sharedCdrive} { |
---|
| 1476 | cd //[info hostname]/c |
---|
| 1477 | glob "\\\\\\\\[info hostname]\\\\c\\\\*Test" |
---|
| 1478 | } //[info hostname]/c/globTest |
---|
| 1479 | test filename-16.14 {windows specific globbing} {win} { |
---|
| 1480 | cd [lindex [glob -types d -dir C:/ *] 0] |
---|
| 1481 | expr {[lsearch -exact [glob {{.,*}*}] ".."] != -1} |
---|
| 1482 | } {1} |
---|
| 1483 | test filename-16.15 {windows specific globbing} {win} { |
---|
| 1484 | cd [lindex [glob -types d -dir C:/ *] 0] |
---|
| 1485 | glob .. |
---|
| 1486 | } {..} |
---|
| 1487 | test filename-16.16 {windows specific globbing} {win} { |
---|
| 1488 | file tail [lindex [glob -nocomplain "[lindex [glob -types d -dir C:/ *] 0]/.."] 0] |
---|
| 1489 | } {..} |
---|
| 1490 | test filename-16.17 {windows specific globbing} {win} { |
---|
| 1491 | cd C:/ |
---|
| 1492 | # Ensure correct trimming of tails with absolute and |
---|
| 1493 | # volume relative globbing. |
---|
| 1494 | set res1 [glob -nocomplain -tails -dir C:/ *] |
---|
| 1495 | set res2 [glob -nocomplain -tails -dir C: *] |
---|
| 1496 | if {$res1 eq $res2} { |
---|
| 1497 | concat ok |
---|
| 1498 | } else { |
---|
| 1499 | concat $res1 ne $res2 |
---|
| 1500 | } |
---|
| 1501 | } {ok} |
---|
| 1502 | |
---|
| 1503 | test filename-17.1 {windows specific special files} {testsetplatform} { |
---|
| 1504 | testsetplatform win |
---|
| 1505 | list [file pathtype com1] [file pathtype con] [file pathtype lpt3] \ |
---|
| 1506 | [file pathtype prn] [file pathtype nul] [file pathtype aux] \ |
---|
| 1507 | [file pathtype foo] |
---|
| 1508 | } {absolute absolute absolute absolute absolute absolute relative} |
---|
| 1509 | if {[testConstraint testsetplatform]} { |
---|
| 1510 | testsetplatform $platform |
---|
| 1511 | } |
---|
| 1512 | |
---|
| 1513 | test filename-17.2 {windows specific glob with executable} {win} { |
---|
| 1514 | makeDirectory execglob |
---|
| 1515 | makeFile contents execglob/abc.exe |
---|
| 1516 | makeFile contents execglob/abc.notexecutable |
---|
| 1517 | set res [glob -nocomplain -dir [temporaryDirectory]/execglob \ |
---|
| 1518 | -tails -types x *] |
---|
| 1519 | removeFile execglob/abc.exe |
---|
| 1520 | removeFile execglob/abc.notexecutable |
---|
| 1521 | removeDirectory execglob |
---|
| 1522 | set res |
---|
| 1523 | } {abc.exe} |
---|
| 1524 | |
---|
| 1525 | test fileName-18.1 {windows - split ADS name correctly} {win} { |
---|
| 1526 | # bug 1194458 |
---|
| 1527 | set x [file split c:/c:d] |
---|
| 1528 | set y [eval [linsert $x 0 file join]] |
---|
| 1529 | list $x $y |
---|
| 1530 | } {{c:/ ./c:d} c:/c:d} |
---|
| 1531 | |
---|
| 1532 | test fileName-19.1 {ensure that [Bug 1325099] stays fixed} { |
---|
| 1533 | # Any non-crashing result is OK |
---|
| 1534 | list [file exists ~//.nonexistant_file] [file exists ~///.nonexistant_file] |
---|
| 1535 | } {0 0} |
---|
| 1536 | |
---|
| 1537 | # cleanup |
---|
| 1538 | catch {file delete -force C:/globTest} |
---|
| 1539 | cd [temporaryDirectory] |
---|
| 1540 | file delete -force globTest |
---|
| 1541 | cd $oldpwd |
---|
| 1542 | set env(HOME) $oldhome |
---|
| 1543 | if {[testConstraint testsetplatform]} { |
---|
| 1544 | testsetplatform $platform |
---|
| 1545 | catch {unset platform} |
---|
| 1546 | } |
---|
| 1547 | catch {unset oldhome temp result globPreResult} |
---|
| 1548 | ::tcltest::cleanupTests |
---|
| 1549 | return |
---|