tests/glob2.test

   1 # This file tests the filename manipulation routines.
   2 #
   3 # This file contains a collection of tests for one or more of the Tcl built-in
   4 # commands. Sourcing this file into Tcl runs the tests and generates output
   5 # 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 of
  11 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12
  13 source [file dirname [info script]]/testing.tcl
  14
  15 needs cmd file
  16 needs cmd glob
  17
  18 testConstraint win [expr {$tcl_platform(platform) eq "windows"}]
  19 testConstraint unix [expr {$tcl_platform(platform) eq "unix"}]
  20 testConstraint unixOrPc 1
  21
  22 proc touch filename {catch {close [open $filename w]}}
  23 global env
  24 \f
  25
  26 test filename-11.2 {Tcl_GlobCmd} -returnCodes error -body {
  27     glob -gorp
  28 } -match glob -result {bad option "-gorp": must be *}
  29 test filename-11.3 {Tcl_GlobCmd} -constraints tcl -body {
  30     glob -nocomplai
  31 } -result {}
  32 test filename-11.4 {Tcl_GlobCmd} -constraints tcl -body {
  33     glob -nocomplain
  34 } -result {}
  35 test filename-11.5 {Tcl_GlobCmd} -constraints tcl -returnCodes error -body {
  36     glob -nocomplain * ~xyqrszzz
  37 } -result {user "xyqrszzz" doesn't exist}
  38 test filename-11.6 {Tcl_GlobCmd} -constraints tcl -returnCodes error -body {
  39     glob ~xyqrszzz
  40 } -result {user "xyqrszzz" doesn't exist}
  41 test filename-11.7 {Tcl_GlobCmd} -returnCodes error -body {
  42     glob -- -nocomplain
  43 } -match glob -result {no files matched glob pattern "-nocomplain"}
  44 test filename-11.8 {Tcl_GlobCmd} -body {
  45     glob -nocomplain -- -nocomplain
  46 } -result {}
  47 test filename-11.13 {Tcl_GlobCmd} tcl {
  48     file join [lindex [glob ~] 0]
  49 } [file join $env(HOME)]
  50 set oldpwd [pwd]
  51 set oldhome $env(HOME)
  52 cd [temporaryDirectory]
  53 set env(HOME) [pwd]
  54 file delete -force globTest
  55 file mkdir globTest/a1/b1
  56 file mkdir globTest/a1/b2
  57 file mkdir globTest/a2/b3
  58 file mkdir globTest/a3
  59 touch globTest/x1.c
  60 touch globTest/y1.c
  61 touch globTest/z1.c
  62 touch "globTest/weird name.c"
  63 touch globTest/a1/b1/x2.c
  64 touch globTest/a1/b2/y2.c
  65 touch globTest/.1
  66 touch globTest/x,z1.c
  67 test filename-11.14 {Tcl_GlobCmd} tcl {
  68     glob ~/globTest
  69 } [list [file join $env(HOME) globTest]]
  70 test filename-11.15 {Tcl_GlobCmd} tcl {
  71     glob ~\\/globTest
  72 } [list [file join $env(HOME) globTest]]
  73 test filename-11.16 {Tcl_GlobCmd} {
  74     glob globTest
  75 } {globTest}
  76 set globname "globTest"
  77 set horribleglobname "glob\[\{Test"
  78 test filename-11.17 {Tcl_GlobCmd} {
  79     lsort [glob -directory $globname *]
  80 } [lsort [list [file join $globname a1] [file join $globname a2]\
  81         [file join $globname a3]\
  82         [file join $globname "weird name.c"]\
  83         [file join $globname x,z1.c]\
  84         [file join $globname x1.c]\
  85         [file join $globname y1.c] [file join $globname z1.c]]]
  86 # Get rid of file/dir if it exists, since it will have been left behind by a
  87 # previous failed run.
  88 if {[file exists $horribleglobname]} {
  89     file delete -force $horribleglobname
  90 }
  91 file rename globTest $horribleglobname
  92 set globname $horribleglobname
  93 test filename-11.22 {Tcl_GlobCmd} {
  94     lsort [glob -dir $globname *]
  95 } [lsort [list [file join $globname a1] [file join $globname a2]\
  96         [file join $globname a3]\
  97         [file join $globname "weird name.c"]\
  98         [file join $globname x,z1.c]\
  99         [file join $globname x1.c]\
 100         [file join $globname y1.c] [file join $globname z1.c]]]
 101
 102 file rename $horribleglobname globTest
 103 set globname globTest
 104 unset horribleglobname
 105
 106 test filename-12.1 {simple globbing} {unixOrPc tcl} {
 107     glob {}
 108 } {.}
 109 test filename-12.3 {simple globbing} {
 110     glob -nocomplain \{a1,a2\}
 111 } {}
 112 set globPreResult globTest/
 113 set x1 x1.c
 114 set y1 y1.c
 115 test filename-12.4 {simple globbing} {unixOrPc} {
 116     lsort [glob globTest/x1.c globTest/y1.c globTest/foo]
 117 } "$globPreResult$x1 $globPreResult$y1"
 118
 119 test filename-13.7 {globbing with brace substitution} {
 120     glob globTest/\{x\}1.c
 121 } "$globPreResult$x1"
 122
 123 test filename-13.9 {globbing with brace substitution} {
 124     lsort [glob globTest/\{x,y\}1.c]
 125 } [list $globPreResult$x1 $globPreResult$y1]
 126 test filename-13.10 {globbing with brace substitution} {
 127     lsort [glob globTest/\{x,,y\}1.c]
 128 } [list $globPreResult$x1 $globPreResult$y1]
 129 test filename-13.11 {globbing with brace substitution} {unixOrPc} {
 130     lsort [glob globTest/\{x,x\\,z,z\}1.c]
 131 } [lsort {globTest/x1.c globTest/x,z1.c globTest/z1.c}]
 132 test filename-13.13 {globbing with brace substitution} {
 133     lsort [glob globTest/{a,b,x,y}1.c]
 134 } [list $globPreResult$x1 $globPreResult$y1]
 135 test filename-13.14 {globbing with brace substitution} {unixOrPc} {
 136     lsort [glob {globTest/{x1,y2,weird name}.c}]
 137 } {{globTest/weird name.c} globTest/x1.c}
 138 test filename-13.16 {globbing with brace substitution} {unixOrPc} {
 139     lsort [glob globTest/{x1.c,a1/*}]
 140 } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
 141 test filename-13.18 {globbing with brace substitution} {unixOrPc} {
 142     lsort [glob globTest/{x1.c,{a},a1/*}]
 143 } {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
 144 test filename-13.20 {globbing with brace substitution} {unixOrPc} {
 145     lsort [glob globTest/{a,x}1/*/{x,y}*]
 146 } {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
 147
 148 test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} {
 149     lsort [glob glo*/*.c]
 150 } {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
 151 test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} {
 152     lsort [glob globTest/?1.c]
 153 } {globTest/x1.c globTest/y1.c globTest/z1.c}
 154 test filename-14.5 {asterisks, question marks, and brackets} -setup {
 155     # The current directory could be anywhere; do this to stop spurious
 156     # matches
 157     file mkdir globTestContext
 158     file rename globTest [file join globTestContext globTest]
 159     set savepwd [pwd]
 160     cd globTestContext
 161 } -constraints {unixOrPc} -body {
 162     lsort [glob */*/*/*.c]
 163 } -cleanup {
 164     # Reset to where we were
 165     cd $savepwd
 166     file rename [file join globTestContext globTest] globTest
 167     file delete globTestContext
 168 } -result {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
 169 test filename-14.7 {asterisks, question marks, and brackets} {
 170     lsort [glob globTest/*]
 171 } {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
 172 test filename-14.9 {asterisks, question marks, and brackets} {unixOrPc} {
 173     lsort [glob globTest/.*]
 174 } {globTest/. globTest/.. globTest/.1}
 175 test filename-14.11 {asterisks, question marks, and brackets} {unixOrPc} {
 176     lsort [glob globTest/*/*]
 177 } {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3}
 178 test filename-14.13 {asterisks, question marks, and brackets} {unixOrPc} {
 179     lsort [glob {globTest/[xyab]1.*}]
 180 } {globTest/x1.c globTest/y1.c}
 181 test filename-14.17 {asterisks, question marks, and brackets} -constraints tcl -setup {
 182     global env
 183     set temp $env(HOME)
 184 } -body {
 185     set env(HOME) [file join $env(HOME) globTest]
 186     glob ~/z*
 187 } -cleanup {
 188     set env(HOME) $temp
 189 } -result [list [file join $env(HOME) globTest z1.c]]
 190 test filename-14.18 {asterisks, question marks, and brackets} {unixOrPc} {
 191     lsort [glob globTest/*.c goo/*]
 192 } {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
 193 test filename-14.20 {asterisks, question marks, and brackets} {
 194     glob -nocomplain goo/*
 195 } {}
 196 test filename-14.21 {asterisks, question marks, and brackets} -body {
 197     glob globTest/*/gorp
 198 } -returnCodes error -result {no files matched glob pattern "globTest/*/gorp"}
 199 test filename-14.22 {asterisks, question marks, and brackets} -body {
 200     glob goo/* x*z foo?q
 201 } -returnCodes error -result {no files matched glob patterns "goo/* x*z foo?q"}
 202 test filename-14.23 {slash globbing} {
 203     glob /
 204 } /
 205
 206 test filename-14.31 {Bug 2918610} -setup {
 207     file mkdir foo
 208     set d foo
 209     makeFile {} bar.soom $d
 210 } -body {
 211     foreach fn [glob $d/bar.soom] {
 212         set root [file rootname $fn]
 213         touch $root
 214     }
 215     llength [glob -directory $d *]
 216 } -cleanup {
 217     file delete -force $d
 218     file delete bar.soom
 219     file delete -force foo
 220 } -result 2
 221
 222 unset globname
 223
 224
 225 test fileName-19.1 {ensure that [Bug 1325099] stays fixed} {
 226     # Any non-crashing result is OK
 227     list [file exists ~//.nonexistant_file] [file exists ~///.nonexistant_file]
 228 } {0 0}
 229
 230 test fileName-20.1 {Bug 1750300} -setup {
 231     set d [makeDirectory foo]
 232     makeFile {} TAGS $d
 233 } -body {
 234     llength [glob -nocomplain -directory $d -- TAGS one two]
 235 } -cleanup {
 236     removeFile TAGS $d
 237     removeDirectory foo
 238 } -result 1
 239 \f
 240 # cleanup
 241 catch {file delete -force C:/globTest}
 242 cd [temporaryDirectory]
 243 file delete -force globTest
 244 cd $oldpwd
 245 set env(HOME) $oldhome
 246 catch {unset oldhome temp result globPreResult}
 247 ::tcltest::cleanupTests
 248 return
 249
 250 # Local Variables:
 251 # mode: tcl
 252 # End: