tests/file.test

   1 source [file dirname [info script]]/testing.tcl
   2
   3 needs cmd file
   4 catch {file link} msg
   5 testConstraint filelink [string match "wrong # args:*" $msg]
   6 catch {file lstat} msg
   7 testConstraint filelstat [string match "wrong # args:*" $msg]
   8 testConstraint unix [expr {$tcl_platform(platform) eq "unix"}]
   9
  10 test join-1.1 "One name" {
  11         file join abc
  12 } {abc}
  13
  14 test join-1.2 "One name with trailing slash" {
  15         file join abc/
  16 } {abc}
  17
  18 test join-1.3 "One name with leading slash" {
  19         file join /abc
  20 } {/abc}
  21
  22 test join-1.4 "One name with leading and trailing slash" {
  23         file join /abc/
  24 } {/abc}
  25
  26 test join-1.5 "Two names" {
  27         file join abc def
  28 } {abc/def}
  29
  30 test join-1.6 "Two names with dir trailing slash" {
  31         file join abc/ def
  32 } {abc/def}
  33
  34 test join-1.7 "Two names with dir leading slash" {
  35         file join /abc def
  36 } {/abc/def}
  37
  38 test join-1.8 "Two names with dir leading and trailing slash" {
  39         file join /abc/ def
  40 } {/abc/def}
  41
  42 test join-1.9 "Two names with file trailing slash" {
  43         file join abc def/
  44 } {abc/def}
  45
  46 test join-1.10 "Two names with file leading slash" {
  47         file join abc /def
  48 } {/def}
  49
  50 test join-1.11 "Two names with file leading and trailing slash" {
  51         file join abc /def/
  52 } {/def}
  53
  54 test join-1.12 "Two names with double slashes" {
  55         file join abc/ /def
  56 } {/def}
  57
  58 test join-1.13 "Join to root" {
  59         file join / abc
  60 } {/abc}
  61
  62 test join-1.14 "Join to root" {
  63         set dir [file join / .]
  64         # Either / or /. is OK here
  65         expr {$dir in {/ /.}}
  66 } 1
  67
  68 test join-1.15 "Join to root" {
  69         file join / /
  70 } {/}
  71
  72 test join-1.16 "Join to root" {
  73         file join /abc /
  74 } {/}
  75
  76 test join-1.17 "With trailing slash" {
  77         file join /abc/def/ ghi/jkl
  78 } {/abc/def/ghi/jkl}
  79
  80 test join-2.1 "Dir is empty string" {
  81         file join "" def
  82 } {def}
  83
  84 test join-2.2 "File is empty string" {
  85         file join abc ""
  86 } {abc}
  87
  88 test join-2.3 "Path too long" jim {
  89         set components [string repeat {abcdefghi } 500]
  90         list [catch [concat file join $components] msg] $msg
  91 } {1 {Path too long}}
  92
  93 test tail-1.1 "One component" {
  94         file tail abc
  95 } {abc}
  96
  97 test tail-1.2 "Two components" {
  98         file tail abc/def
  99 } {def}
 100
 101 test tail-1.3 "Absolute one component" {
 102         file tail /abc
 103 } {abc}
 104
 105 test tail-1.4 "Trailing slash" {
 106         file tail abc/
 107 } {abc}
 108
 109 test dirname-1.1 "One component" {
 110         file dirname abc
 111 } {.}
 112
 113 test dirname-1.2 "Two components" {
 114         file dirname abc/def
 115 } {abc}
 116
 117 test dirname-1.3 "Absolute one component" {
 118         file dirname /abc
 119 } {/}
 120
 121 test dirname-1.4 "Trailing slash" {
 122         file dirname abc/
 123 } {.}
 124
 125 test dirname-1.5 ".." {
 126         file dirname ..
 127 } {.}
 128
 129 test dirname-1.6 "abc/.." {
 130         file dirname abc/..
 131 } {abc}
 132
 133 test dirname-1.7 "../abc" {
 134         file dirname ../abc
 135 } {..}
 136
 137 test stat-1.1 {file stat usage} -body {
 138         file stat
 139 } -returnCodes error -match glob -result {wrong # args: should be "file stat name*"}
 140
 141 test stat-1.2 {file stat usage} -body {
 142         file stat nonexistent a
 143 } -returnCodes error -match glob -result {could not read "nonexistent": *}
 144
 145 test stat-1.3 {file stat} {
 146         unset -nocomplain a
 147         file stat [info script] a
 148         set a(type)
 149 } {file}
 150
 151 test stat-1.4 {file stat update array} {
 152         set a(type) bogus
 153         file stat [info nameofexecutable] a
 154         set a(type)
 155 } {file}
 156
 157 test stat-1.5 {file stat update bad array} -body {
 158         unset -nocomplain a
 159         # invalid dict/array
 160         set a {1 2 3}
 161         file stat [info nameofexecutable] a
 162 } -returnCodes error -result {can't set "a(dev)": variable isn't array}
 163
 164 test stat-1.7 {file stat no variable} jim {
 165         set a [file stat [info script]]
 166         set a(type)
 167 } {file}
 168
 169 test ext-1.1 {file ext} -body {
 170         file ext
 171 } -returnCodes error -result {wrong # args: should be "file extension name"}
 172
 173 test ext-1.2 {file ext basic} {
 174         file ext abc.def
 175 } {.def}
 176
 177 test ext-1.3 {file ext path} {
 178         file ext 123/abc.def
 179 } {.def}
 180
 181 test ext-1.4 {file ext noext} {
 182         file ext abc
 183 } {}
 184
 185 test ext-1.5 {file ext noext} {
 186         file ext abc.def/ghi
 187 } {}
 188
 189 test rootname-1.1 {file rootname} -body {
 190         file rootname
 191 } -returnCodes error -result {wrong # args: should be "file rootname name"}
 192
 193 test rootname-1.2 {file rootname basic} -body {
 194         file rootname abc
 195 } -result {abc}
 196
 197 test rootname-1.3 {file rootname basic} -body {
 198         file rootname abc/def
 199 } -result {abc/def}
 200
 201 test rootname-1.4 {file rootname basic} -body {
 202         file rootname abc.c
 203 } -result {abc}
 204
 205 test rootname-1.5 {file rootname basic} -body {
 206         file rootname abc/def.c
 207 } -result {abc/def}
 208
 209 test rootname-1.6 {file rootname odd cases} -body {
 210         file rootname abc/def.c/ghi
 211 } -result {abc/def.c/ghi}
 212
 213 test rootname-1.7 {file rootname odd cases} -body {
 214         file rootname abc/def.c/
 215 } -result {abc/def.c/}
 216
 217 test rootname-1.8 {file rootname odd cases} -body {
 218         file rootname abc/def.c//
 219 } -result {abc/def.c//}
 220
 221 test readable-1.1 {file readable} {
 222         file readable [info script]
 223 } {1}
 224
 225 test writable-1.1 {file writable} -body {
 226         set name tmp.[pid]
 227         makeFile testing $name
 228         file writable $name
 229 } -result 1 -cleanup {
 230         file delete $name
 231 }
 232
 233 test rename-1.1 {file rename usage} -body {
 234         file rename
 235 } -returnCodes error -match glob -result {wrong # args: should be *}
 236
 237 test rename-1.2 {file rename usage} -body {
 238         file rename -badarg name1 name2
 239 } -returnCodes error -match glob -result {*}
 240
 241 test rename-1.1 {file rename, target exists} -body {
 242         set name1 tmp.[pid]
 243         set name2 tmp2.[pid]
 244         makeFile testing $name1
 245         makeFile testing2 $name2
 246         file rename $name1 $name2
 247 } -returnCodes error -match glob -result {error renaming *}
 248
 249 test rename-1.2 {file rename -force, target exists} -body {
 250         file rename -force $name1 $name2
 251         list [file exists $name1] [file exists $name2]
 252 } -result {0 1} -cleanup {
 253         file delete $name2
 254 }
 255
 256 test link-1.1 {file link usage} -constraints filelink -body {
 257         file link
 258 } -returnCodes error -match glob -result {wrong # args: should be "file link*}
 259
 260 test link-1.2 {file hard link} -constraints filelink -body {
 261         set name tmp.[pid]
 262         file link $name [info script]
 263         file exists $name
 264 } -result {1} -cleanup {
 265         file delete $name
 266 }
 267
 268 test link-1.3 {file hard link} -constraints filelink -body {
 269         set name tmp.[pid]
 270         file link -hard $name [info script]
 271         file exists $name
 272 } -result {1} -cleanup {
 273         file delete $name
 274 }
 275
 276 test link-1.4 {file sym link} -constraints filelink -body {
 277         set name tmp.[pid]
 278         file link -sym $name [info script]
 279         list [file exists $name] [file tail [file readlink $name]]
 280 } -result {1 file.test} -cleanup {
 281         file delete $name
 282 }
 283
 284 test link-1.5 {file readlink, bad link} -constraints filelink -body {
 285         file readlink [info script]
 286 } -returnCodes error -match glob -result {could not read*link "*file.test": *}
 287
 288 test link-1.6 {file link badopt} -constraints filelink -body {
 289         file link -bad name1 name2
 290 } -returnCodes error -match glob -result {bad * "-bad": must be *}
 291
 292 test lstat-1.1 {file lstat} -constraints filelstat -body {
 293         file lstat
 294 } -returnCodes error -match glob -result {wrong # args: should be "file lstat name *}
 295
 296 test lstat-1.2 {file lstat} -constraints filelstat -body {
 297         file lstat nonexistent ls
 298 } -returnCodes error -match glob -result {could not read "nonexistent": *}
 299
 300 test lstat-1.3 {file lstat} -constraints {filelink filelstat} -body {
 301         set name tmp.[pid]
 302         file link -sym $name [info script]
 303         unset -nocomplain s ls
 304         file lstat $name ls
 305         file stat [info script] s
 306         list $ls(type) $s(type)
 307 } -match glob -result {link file} -cleanup {
 308         file delete $name
 309 }
 310
 311 test type-1.1 {file type} {
 312         file type [info script]
 313 } {file}
 314
 315 test type-1.2 {file type} {
 316         file type [file dirname [info script]]
 317 } {directory}
 318
 319 test type-1.2 {file type} -body {
 320         file type nonexistent
 321 } -returnCodes error -match glob -result {could not read "nonexistent": *}
 322
 323 test isfile-1.1 {file isfile} -body {
 324         file isfile
 325 } -returnCodes error -result {wrong # args: should be "file isfile name"}
 326
 327 test isfile-1.2 {file isfile} {
 328         file isfile [info script]
 329 } {1}
 330
 331 test isfile-1.3 {file isfile} {
 332         file isfile [file dirname [info script]]
 333 } {0}
 334
 335 test size-1.1 {file size} -body {
 336         file size
 337 } -returnCodes error -result {wrong # args: should be "file size name"}
 338
 339 test size-1.2 {file size} -body {
 340         file size nonexistent
 341 } -returnCodes error -match glob -result {could not read "nonexistent":*}
 342
 343 test size-1.3 {file size} {
 344         set size [file size [info script]]
 345         file stat [info script] s
 346         expr {$size - $s(size)}
 347 } {0}
 348
 349 test mtime-1.1 {file mtime} -body {
 350         file mtime
 351 } -returnCodes error -result {wrong # args: should be "file mtime name ?time?"}
 352
 353 test mtime-1.2 {file mtime} -body {
 354         file mtime nonexistent
 355 } -returnCodes error -match glob -result {could not read "nonexistent":*}
 356
 357 test mtime-1.3 {file mtime} -body {
 358         file mtime [info script] bad
 359 } -returnCodes error -result {expected integer but got "bad"}
 360
 361 test mtime-1.4 {file mtime} {
 362         set mtime [file mtime [info script]]
 363         file stat [info script] s
 364         if {$mtime != $s(mtime)} {
 365                 error "mtime was $mtime but s(mtime) was $s(mtime)"
 366         }
 367 } {}
 368
 369 test mtime-1.5 {file mtime} -constraints unix -body {
 370         set name tmp.[pid]
 371         makeFile testing $name
 372         set t [file mtime [info script]]
 373         file mtime $name $t
 374         expr {$t - [file mtime $name]}
 375 } -result {0} -cleanup {
 376         file delete $name
 377 }
 378
 379 test atime-1.1 {file atime} -body {
 380         file atime
 381 } -returnCodes error -match glob -result {wrong # args: should be "file atime name*}
 382
 383 test atime-1.2 {file atime} -body {
 384         file atime nonexistent
 385 } -returnCodes error -match glob -result {could not read "nonexistent":*}
 386
 387 test atime-1.3 {file atime} {
 388         set atime [file atime [info script]]
 389         file stat [info script] s
 390         expr {$atime - $s(atime)}
 391 } {0}
 392
 393 # These tests are courtesy of picol
 394
 395 test file.12.1 "picol test" {file dirname /foo/bar/grill.txt}  /foo/bar
 396 test file.12.2 "picol test" {file dirname /foo/bar/baz/}       /foo/bar
 397 test file.12.3 "picol test" {file dirname /foo/bar/baz///}     /foo/bar
 398 test file.12.4 "picol test" {file dirname /foo/bar/baz///qux}  /foo/bar/baz
 399 test file.12.5 "picol test" {file dirname foo/bar/grill.txt}   foo/bar
 400 test file.12.6 "picol test" {file dirname foo/bar/baz/}        foo/bar
 401 test file.12.7 "picol test" {file dirname {}}    .
 402 test file.12.8 "picol test" {file dirname /}     /
 403 test file.12.9 "picol test" {file dirname ///}   /
 404
 405 test file.13.1 "picol test" {file tail /foo/bar/grill.txt}   grill.txt
 406 test file.13.2 "picol test" {file tail /foo/bar/baz/}        baz
 407 test file.13.3 "picol test" {file tail /foo/bar/baz///}      baz
 408 test file.13.4 "picol test" {file dirname /foo/bar/baz///qux}  /foo/bar/baz
 409 test file.13.5 "picol test" {file tail foo/bar/grill.txt}    grill.txt
 410 test file.13.6 "picol test" {file tail foo/bar/baz/}         baz
 411 test file.13.7 "picol test" {file tail {}}    {}
 412 test file.13.8 "picol test" {file tail /}     {}
 413 test file.13.9 "picol test" {file tail ///}   {}
 414
 415 test file.14   "picol test" {file join foo}               foo
 416 test file.15   "picol test" {file join foo bar}           foo/bar
 417 test file.16   "picol test" {file join foo /bar}          /bar
 418
 419 if {$tcl_platform(platform) eq {windows}} {
 420     test file.17  "picol test" {file join foo C:/bar grill}  C:/bar/grill
 421 }
 422
 423 test file.18   "picol test" {file split {/foo/space station/bar}}  {/ foo {space station} bar}
 424 test file.19   "picol test" {file split {/foo/space station/bar/}}  {/ foo {space station} bar}
 425 test file.20   "picol test" {file split {foo/space station/bar}}  {foo {space station} bar}
 426 test file.21   "picol test" {file split foo///bar}  {foo bar}
 427 test file.22   "picol test" {file split foo}  foo
 428
 429 testreport