1# The file tests the tclCmdAH.c file. 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 © 1996-1998 Sun Microsystems, Inc. 8# Copyright © 1998-1999 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 13if {"::tcltest" ni [namespace children]} { 14 package require tcltest 2.5 15 namespace import -force ::tcltest::* 16} 17 18::tcltest::loadTestedCommands 19catch [list package require -exact tcl::test [info patchlevel]] 20 21testConstraint testchmod [llength [info commands testchmod]] 22testConstraint testsetplatform [llength [info commands testsetplatform]] 23testConstraint testvolumetype [llength [info commands testvolumetype]] 24testConstraint time64bit [expr { 25 $::tcl_platform(pointerSize) >= 8 || 26 [llength [info command testsize]] && [testsize st_mtime] >= 8 27}] 28testConstraint linkDirectory [expr { 29 ![testConstraint win] || 30 ($::tcl_platform(osVersion) >= 5.0 31 && [lindex [file system [temporaryDirectory]] 1] eq "NTFS") 32}] 33testConstraint notWine [expr {![info exists ::env(CI_USING_WINE)]}] 34 35global env 36set cmdAHwd [pwd] 37catch {set platform [testgetplatform]} 38 39proc waitForEvenSecondForFAT {} { 40 # Windows 9x uses filesystems (the FAT* family of FSes) without enough 41 # data in its timestamps for even per-second-accurate timings. :^( 42 # This procedure based on work by Helmut Giese 43 if { 44 [testConstraint win] && 45 [lindex [file system [temporaryDirectory]] 1] ne "NTFS" 46 } then { 47 # Assume non-NTFS means FAT{12,16,32} and hence in need of special 48 # help... 49 set start [clock seconds] 50 while {1} { 51 set now [clock seconds] 52 if {$now!=$start && !($now & 1)} { 53 break 54 } 55 after 50 56 } 57 } 58} 59 60test cmdAH-0.1 {Tcl_BreakObjCmd, errors} -body { 61 break foo 62} -returnCodes error -result {wrong # args: should be "break"} 63test cmdAH-0.2 {Tcl_BreakObjCmd, success} { 64 list [catch {break} msg] $msg 65} {3 {}} 66 67# Tcl_CaseObjCmd is tested in case.test 68 69test cmdAH-1.1 {Tcl_CatchObjCmd, errors} -returnCodes error -body { 70 catch 71} -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"} 72test cmdAH-1.2 {Tcl_CatchObjCmd, errors} { 73 list [catch {catch foo bar baz} msg] $msg 74} {0 1} 75test cmdAH-1.3 {Tcl_CatchObjCmd, errors} -returnCodes error -body { 76 catch foo bar baz spaz 77} -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"} 78test cmdAH-1.4 {Bug 3595576} { 79 catch {catch {} -> noSuchNs::var} 80} 1 81test cmdAH-1.5 {Bug 3595576} { 82 catch {catch error -> noSuchNs::var} 83} 1 84 85test cmdAH-2.1 {Tcl_CdObjCmd} -returnCodes error -body { 86 cd foo bar 87} -result {wrong # args: should be "cd ?dirName?"} 88set foodir [file join [temporaryDirectory] foo] 89test cmdAH-2.2 {Tcl_CdObjCmd} -setup { 90 file delete -force $foodir 91 set oldpwd [pwd] 92} -body { 93 file mkdir $foodir 94 cd $foodir 95 file tail [pwd] 96} -cleanup { 97 cd $oldpwd 98 file delete $foodir 99} -result foo 100test cmdAH-2.3 {Tcl_CdObjCmd} -setup { 101 global env 102 set oldpwd [pwd] 103 set temp $env(HOME) 104 file delete -force $foodir 105} -body { 106 set env(HOME) $oldpwd 107 file mkdir $foodir 108 cd $foodir 109 cd ~ 110 string equal [pwd] $oldpwd 111} -cleanup { 112 cd $oldpwd 113 file delete $foodir 114 set env(HOME) $temp 115} -result 1 116test cmdAH-2.4 {Tcl_CdObjCmd} -setup { 117 global env 118 set oldpwd [pwd] 119 set temp $env(HOME) 120 file delete -force $foodir 121} -body { 122 set env(HOME) $oldpwd 123 file mkdir $foodir 124 cd $foodir 125 cd 126 string equal [pwd] $oldpwd 127} -cleanup { 128 cd $oldpwd 129 file delete $foodir 130 set env(HOME) $temp 131} -result 1 132test cmdAH-2.5 {Tcl_CdObjCmd} -returnCodes error -body { 133 cd ~~ 134} -result {user "~" doesn't exist} 135test cmdAH-2.6 {Tcl_CdObjCmd} -returnCodes error -body { 136 cd _foobar 137} -result {couldn't change working directory to "_foobar": no such file or directory} 138test cmdAH-2.6.1 {Tcl_CdObjCmd} -returnCodes error -body { 139 cd "" 140} -result {couldn't change working directory to "": no such file or directory} 141test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup { 142 set dir [pwd] 143} -body { 144 cd / 145 pwd 146} -cleanup { 147 cd $dir 148} -result {/} 149test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -setup { 150 set dir [pwd] 151} -returnCodes error -body { 152 cd .\x00 153} -cleanup { 154 cd $dir 155} -match glob -result "couldn't change working directory to \".\x00\": *" 156test cmdAH-2.7 {Tcl_ConcatObjCmd} { 157 concat 158} {} 159test cmdAH-2.8 {Tcl_ConcatObjCmd} { 160 concat a 161} a 162test cmdAH-2.9 {Tcl_ConcatObjCmd} { 163 concat a {b c} 164} {a b c} 165 166test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} -returnCodes error -body { 167 continue foo 168} -result {wrong # args: should be "continue"} 169test cmdAH-3.2 {Tcl_ContinueObjCmd, success} { 170 list [catch {continue} msg] $msg 171} {4 {}} 172 173test cmdAH-4.1 {Tcl_EncodingObjCmd} -returnCodes error -body { 174 encoding 175} -result {wrong # args: should be "encoding subcommand ?arg ...?"} 176test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body { 177 encoding foo 178} -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, or system} 179test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body { 180 encoding convertto 181} -result {wrong # args: should be "encoding convertto ?encoding? data"} 182test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body { 183 encoding convertto foo bar 184} -result {unknown encoding "foo"} 185test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup { 186 set system [encoding system] 187} -body { 188 encoding system jis0208 189 encoding convertto 乎 190} -cleanup { 191 encoding system $system 192} -result 8C 193test cmdAH-4.6 {Tcl_EncodingObjCmd} -setup { 194 set system [encoding system] 195} -body { 196 encoding system iso8859-1 197 encoding convertto jis0208 乎 198} -cleanup { 199 encoding system $system 200} -result 8C 201test cmdAH-4.7 {Tcl_EncodingObjCmd} -returnCodes error -body { 202 encoding convertfrom 203} -result {wrong # args: should be "encoding convertfrom ?encoding? data"} 204test cmdAH-4.8 {Tcl_EncodingObjCmd} -returnCodes error -body { 205 encoding convertfrom foo bar 206} -result {unknown encoding "foo"} 207test cmdAH-4.9 {Tcl_EncodingObjCmd} -setup { 208 set system [encoding system] 209} -body { 210 encoding system jis0208 211 encoding convertfrom 8C 212} -cleanup { 213 encoding system $system 214} -result 乎 215test cmdAH-4.10 {Tcl_EncodingObjCmd} -setup { 216 set system [encoding system] 217} -body { 218 encoding system iso8859-1 219 encoding convertfrom jis0208 8C 220} -cleanup { 221 encoding system $system 222} -result 乎 223test cmdAH-4.11 {Tcl_EncodingObjCmd} -returnCodes error -body { 224 encoding names foo 225} -result {wrong # args: should be "encoding names"} 226test cmdAH-4.12 {Tcl_EncodingObjCmd} -returnCodes error -body { 227 encoding system foo bar 228} -result {wrong # args: should be "encoding system ?encoding?"} 229test cmdAH-4.13 {Tcl_EncodingObjCmd} -setup { 230 set system [encoding system] 231} -body { 232 encoding system iso8859-1 233 encoding system 234} -cleanup { 235 encoding system $system 236} -result iso8859-1 237 238test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body { 239 file 240} -result {wrong # args: should be "file subcommand ?arg ...?"} 241test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body { 242 file x 243} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, type, volumes, or writable} 244test cmdAH-5.3 {Tcl_FileObjCmd} -returnCodes error -body { 245 file exists 246} -result {wrong # args: should be "file exists name"} 247test cmdAH-5.4 {Tcl_FileObjCmd} { 248 file exists "" 249} 0 250 251# volume 252test cmdAH-6.1 {Tcl_FileObjCmd: volumes} -returnCodes error -body { 253 file volumes x 254} -result {wrong # args: should be "file volumes"} 255test cmdAH-6.2 {Tcl_FileObjCmd: volumes} -body { 256 lindex [file volumes] 0 257} -match glob -result ?* 258test cmdAH-6.3 {Tcl_FileObjCmd: volumes} -constraints unix -body { 259 set volumeList [file volumes] 260 glob -nocomplain [lindex $volumeList 0]* 261} -match glob -result * 262test cmdAH-6.4 {Tcl_FileObjCmd: volumes} -constraints win -body { 263 set volumeList [string tolower [file volumes]] 264 set element [lsearch -exact $volumeList "c:/"] 265 list [expr {$element>=0}] [glob -nocomplain [lindex $volumeList $element]*] 266} -match glob -result {1 *} 267 268# attributes 269test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} -setup { 270 set foofile [makeFile abcde foo.file] 271 catch {file delete -force $foofile} 272} -body { 273 close [open $foofile w] 274 file attributes $foofile 275} -cleanup { 276 # We used [makeFile] so we undo with [removeFile] 277 removeFile $foofile 278} -match glob -result * 279 280# dirname 281test cmdAH-8.1 {Tcl_FileObjCmd: dirname} -returnCodes error -body { 282 file dirname a b 283} -result {wrong # args: should be "file dirname name"} 284test cmdAH-8.2 {Tcl_FileObjCmd: dirname} testsetplatform { 285 testsetplatform unix 286 file dirname /a/b 287} /a 288test cmdAH-8.3 {Tcl_FileObjCmd: dirname} testsetplatform { 289 testsetplatform unix 290 file dirname {} 291} . 292test cmdAH-8.5 {Tcl_FileObjCmd: dirname} testsetplatform { 293 testsetplatform win 294 file dirname {} 295} . 296test cmdAH-8.6 {Tcl_FileObjCmd: dirname} testsetplatform { 297 testsetplatform unix 298 file dirname .def 299} . 300test cmdAH-8.8 {Tcl_FileObjCmd: dirname} testsetplatform { 301 testsetplatform win 302 file dirname a 303} . 304test cmdAH-8.9 {Tcl_FileObjCmd: dirname} testsetplatform { 305 testsetplatform unix 306 file dirname a/b/c.d 307} a/b 308test cmdAH-8.10 {Tcl_FileObjCmd: dirname} testsetplatform { 309 testsetplatform unix 310 file dirname a/b.c/d 311} a/b.c 312test cmdAH-8.11 {Tcl_FileObjCmd: dirname} testsetplatform { 313 testsetplatform unix 314 file dirname /. 315} / 316test cmdAH-8.12 {Tcl_FileObjCmd: dirname} testsetplatform { 317 testsetplatform unix 318 file dirname / 319} / 320test cmdAH-8.13 {Tcl_FileObjCmd: dirname} testsetplatform { 321 testsetplatform unix 322 file dirname /foo 323} / 324test cmdAH-8.14 {Tcl_FileObjCmd: dirname} testsetplatform { 325 testsetplatform unix 326 file dirname //foo 327} / 328test cmdAH-8.15 {Tcl_FileObjCmd: dirname} testsetplatform { 329 testsetplatform unix 330 file dirname //foo/bar 331} /foo 332test cmdAH-8.16 {Tcl_FileObjCmd: dirname} testsetplatform { 333 testsetplatform unix 334 file dirname {//foo\/bar/baz} 335} {/foo\/bar} 336test cmdAH-8.17 {Tcl_FileObjCmd: dirname} testsetplatform { 337 testsetplatform unix 338 file dirname {//foo\/bar/baz/blat} 339} {/foo\/bar/baz} 340test cmdAH-8.18 {Tcl_FileObjCmd: dirname} testsetplatform { 341 testsetplatform unix 342 file dirname /foo// 343} / 344test cmdAH-8.19 {Tcl_FileObjCmd: dirname} testsetplatform { 345 testsetplatform unix 346 file dirname ./a 347} . 348test cmdAH-8.20 {Tcl_FileObjCmd: dirname} testsetplatform { 349 testsetplatform unix 350 file dirname a/.a 351} a 352test cmdAH-8.21 {Tcl_FileObjCmd: dirname} testsetplatform { 353 testsetplatform windows 354 file dirname c:foo 355} c: 356test cmdAH-8.22 {Tcl_FileObjCmd: dirname} testsetplatform { 357 testsetplatform windows 358 file dirname c: 359} c: 360test cmdAH-8.23 {Tcl_FileObjCmd: dirname} testsetplatform { 361 testsetplatform windows 362 file dirname c:/ 363} c:/ 364test cmdAH-8.24 {Tcl_FileObjCmd: dirname} testsetplatform { 365 testsetplatform windows 366 file dirname {c:\foo} 367} c:/ 368test cmdAH-8.25 {Tcl_FileObjCmd: dirname} testsetplatform { 369 testsetplatform windows 370 file dirname {//foo/bar/baz} 371} //foo/bar 372test cmdAH-8.26 {Tcl_FileObjCmd: dirname} testsetplatform { 373 testsetplatform windows 374 file dirname {//foo/bar} 375} //foo/bar 376test cmdAH-8.38 {Tcl_FileObjCmd: dirname} testsetplatform { 377 testsetplatform unix 378 file dirname ~/foo 379} ~ 380test cmdAH-8.39 {Tcl_FileObjCmd: dirname} testsetplatform { 381 testsetplatform unix 382 file dirname ~bar/foo 383} ~bar 384test cmdAH-8.43 {Tcl_FileObjCmd: dirname} -setup { 385 global env 386 set temp $env(HOME) 387} -constraints testsetplatform -body { 388 set env(HOME) "/homewontexist/test" 389 testsetplatform unix 390 file dirname ~ 391} -cleanup { 392 set env(HOME) $temp 393} -result /homewontexist 394test cmdAH-8.44 {Tcl_FileObjCmd: dirname} -setup { 395 global env 396 set temp $env(HOME) 397} -constraints testsetplatform -body { 398 set env(HOME) "~" 399 testsetplatform unix 400 file dirname ~ 401} -cleanup { 402 set env(HOME) $temp 403} -result ~ 404test cmdAH-8.45 {Tcl_FileObjCmd: dirname} -setup { 405 set temp $::env(HOME) 406} -constraints {win testsetplatform} -match regexp -body { 407 set ::env(HOME) "/homewontexist/test" 408 testsetplatform windows 409 file dirname ~ 410} -cleanup { 411 set ::env(HOME) $temp 412} -result {([a-zA-Z]:?)/homewontexist} 413test cmdAH-8.46 {Tcl_FileObjCmd: dirname} { 414 set f [file normalize [info nameof]] 415 file exists $f 416 set res1 [file dirname [file join $f foo/bar]] 417 set res2 [file dirname "${f}/foo/bar"] 418 if {$res1 eq $res2} { 419 return "ok" 420 } 421 return "file dirname problem, $res1, $res2 not equal" 422} {ok} 423 424# tail 425test cmdAH-9.1 {Tcl_FileObjCmd: tail} -returnCodes error -body { 426 file tail a b 427} -result {wrong # args: should be "file tail name"} 428test cmdAH-9.2 {Tcl_FileObjCmd: tail} testsetplatform { 429 testsetplatform unix 430 file tail /a/b 431} b 432test cmdAH-9.3 {Tcl_FileObjCmd: tail} testsetplatform { 433 testsetplatform unix 434 file tail {} 435} {} 436test cmdAH-9.5 {Tcl_FileObjCmd: tail} testsetplatform { 437 testsetplatform win 438 file tail {} 439} {} 440test cmdAH-9.6 {Tcl_FileObjCmd: tail} testsetplatform { 441 testsetplatform unix 442 file tail .def 443} .def 444test cmdAH-9.8 {Tcl_FileObjCmd: tail} testsetplatform { 445 testsetplatform win 446 file tail a 447} a 448test cmdAH-9.9 {Tcl_FileObjCmd: tail} testsetplatform { 449 testsetplatform unix 450 file ta a/b/c.d 451} c.d 452test cmdAH-9.10 {Tcl_FileObjCmd: tail} testsetplatform { 453 testsetplatform unix 454 file tail a/b.c/d 455} d 456test cmdAH-9.11 {Tcl_FileObjCmd: tail} testsetplatform { 457 testsetplatform unix 458 file tail /. 459} . 460test cmdAH-9.12 {Tcl_FileObjCmd: tail} testsetplatform { 461 testsetplatform unix 462 file tail / 463} {} 464test cmdAH-9.13 {Tcl_FileObjCmd: tail} testsetplatform { 465 testsetplatform unix 466 file tail /foo 467} foo 468test cmdAH-9.14 {Tcl_FileObjCmd: tail} testsetplatform { 469 testsetplatform unix 470 file tail //foo 471} foo 472test cmdAH-9.15 {Tcl_FileObjCmd: tail} testsetplatform { 473 testsetplatform unix 474 file tail //foo/bar 475} bar 476test cmdAH-9.16 {Tcl_FileObjCmd: tail} testsetplatform { 477 testsetplatform unix 478 file tail {//foo\/bar/baz} 479} baz 480test cmdAH-9.17 {Tcl_FileObjCmd: tail} testsetplatform { 481 testsetplatform unix 482 file tail {//foo\/bar/baz/blat} 483} blat 484test cmdAH-9.18 {Tcl_FileObjCmd: tail} testsetplatform { 485 testsetplatform unix 486 file tail /foo// 487} foo 488test cmdAH-9.19 {Tcl_FileObjCmd: tail} testsetplatform { 489 testsetplatform unix 490 file tail ./a 491} a 492test cmdAH-9.20 {Tcl_FileObjCmd: tail} testsetplatform { 493 testsetplatform unix 494 file tail a/.a 495} .a 496test cmdAH-9.21 {Tcl_FileObjCmd: tail} testsetplatform { 497 testsetplatform windows 498 file tail c:foo 499} foo 500test cmdAH-9.22 {Tcl_FileObjCmd: tail} testsetplatform { 501 testsetplatform windows 502 file tail c: 503} {} 504test cmdAH-9.23 {Tcl_FileObjCmd: tail} testsetplatform { 505 testsetplatform windows 506 file tail c:/ 507} {} 508test cmdAH-9.24 {Tcl_FileObjCmd: tail} testsetplatform { 509 testsetplatform windows 510 file tail {c:\foo} 511} foo 512test cmdAH-9.25 {Tcl_FileObjCmd: tail} testsetplatform { 513 testsetplatform windows 514 file tail {//foo/bar/baz} 515} baz 516test cmdAH-9.26 {Tcl_FileObjCmd: tail} testsetplatform { 517 testsetplatform windows 518 file tail {//foo/bar} 519} {} 520test cmdAH-9.42 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup { 521 global env 522 set temp $env(HOME) 523} -body { 524 set env(HOME) "/home/test" 525 testsetplatform unix 526 file tail ~ 527} -cleanup { 528 set env(HOME) $temp 529} -result test 530test cmdAH-9.43 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup { 531 global env 532 set temp $env(HOME) 533} -body { 534 set env(HOME) "~" 535 testsetplatform unix 536 file tail ~ 537} -cleanup { 538 set env(HOME) $temp 539} -result {} 540test cmdAH-9.44 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup { 541 global env 542 set temp $env(HOME) 543} -body { 544 set env(HOME) "/home/test" 545 testsetplatform windows 546 file tail ~ 547} -cleanup { 548 set env(HOME) $temp 549} -result test 550test cmdAH-9.46 {Tcl_FileObjCmd: tail} testsetplatform { 551 testsetplatform unix 552 file tail {f.oo\bar/baz.bat} 553} baz.bat 554test cmdAH-9.47 {Tcl_FileObjCmd: tail} testsetplatform { 555 testsetplatform windows 556 file tail c:foo 557} foo 558test cmdAH-9.48 {Tcl_FileObjCmd: tail} testsetplatform { 559 testsetplatform windows 560 file tail c: 561} {} 562test cmdAH-9.49 {Tcl_FileObjCmd: tail} testsetplatform { 563 testsetplatform windows 564 file tail c:/foo 565} foo 566test cmdAH-9.50 {Tcl_FileObjCmd: tail} testsetplatform { 567 testsetplatform windows 568 file tail {c:/foo\bar} 569} bar 570test cmdAH-9.51 {Tcl_FileObjCmd: tail} testsetplatform { 571 testsetplatform windows 572 file tail {foo\bar} 573} bar 574test cmdAH-9.52 {Tcl_FileObjCmd: tail / normalize, bug 7a9dc52b29} { 575 list \ 576 [file tail {~/~foo}] \ 577 [file tail {~/test/~foo}] \ 578 [file tail [file normalize {~/~foo}]] \ 579 [file tail [file normalize {~/test/~foo}]] 580} [lrepeat 4 ./~foo] 581 582# rootname 583test cmdAH-10.1 {Tcl_FileObjCmd: rootname} -returnCodes error -body { 584 file rootname a b 585} -result {wrong # args: should be "file rootname name"} 586test cmdAH-10.2 {Tcl_FileObjCmd: rootname} testsetplatform { 587 testsetplatform unix 588 file rootname {} 589} {} 590test cmdAH-10.3 {Tcl_FileObjCmd: rootname} testsetplatform { 591 testsetplatform unix 592 file ro foo 593} foo 594test cmdAH-10.4 {Tcl_FileObjCmd: rootname} testsetplatform { 595 testsetplatform unix 596 file rootname foo. 597} foo 598test cmdAH-10.5 {Tcl_FileObjCmd: rootname} testsetplatform { 599 testsetplatform unix 600 file rootname .foo 601} {} 602test cmdAH-10.6 {Tcl_FileObjCmd: rootname} testsetplatform { 603 testsetplatform unix 604 file rootname abc.def 605} abc 606test cmdAH-10.7 {Tcl_FileObjCmd: rootname} testsetplatform { 607 testsetplatform unix 608 file rootname abc.def.ghi 609} abc.def 610test cmdAH-10.8 {Tcl_FileObjCmd: rootname} testsetplatform { 611 testsetplatform unix 612 file rootname a/b/c.d 613} a/b/c 614test cmdAH-10.9 {Tcl_FileObjCmd: rootname} testsetplatform { 615 testsetplatform unix 616 file rootname a/b.c/d 617} a/b.c/d 618test cmdAH-10.10 {Tcl_FileObjCmd: rootname} testsetplatform { 619 testsetplatform unix 620 file rootname a/b.c/ 621} a/b.c/ 622test cmdAH-10.23 {Tcl_FileObjCmd: rootname} testsetplatform { 623 testsetplatform windows 624 file rootname {} 625} {} 626test cmdAH-10.24 {Tcl_FileObjCmd: rootname} testsetplatform { 627 testsetplatform windows 628 file ro foo 629} foo 630test cmdAH-10.25 {Tcl_FileObjCmd: rootname} testsetplatform { 631 testsetplatform windows 632 file rootname foo. 633} foo 634test cmdAH-10.26 {Tcl_FileObjCmd: rootname} testsetplatform { 635 testsetplatform windows 636 file rootname .foo 637} {} 638test cmdAH-10.27 {Tcl_FileObjCmd: rootname} testsetplatform { 639 testsetplatform windows 640 file rootname abc.def 641} abc 642test cmdAH-10.28 {Tcl_FileObjCmd: rootname} testsetplatform { 643 testsetplatform windows 644 file rootname abc.def.ghi 645} abc.def 646test cmdAH-10.29 {Tcl_FileObjCmd: rootname} testsetplatform { 647 testsetplatform windows 648 file rootname a/b/c.d 649} a/b/c 650test cmdAH-10.30 {Tcl_FileObjCmd: rootname} testsetplatform { 651 testsetplatform windows 652 file rootname a/b.c/d 653} a/b.c/d 654test cmdAH-10.31 {Tcl_FileObjCmd: rootname} testsetplatform { 655 testsetplatform windows 656 file rootname a\\b.c\\ 657} a\\b.c\\ 658test cmdAH-10.32 {Tcl_FileObjCmd: rootname} testsetplatform { 659 testsetplatform windows 660 file rootname a\\b\\c.d 661} a\\b\\c 662test cmdAH-10.33 {Tcl_FileObjCmd: rootname} testsetplatform { 663 testsetplatform windows 664 file rootname a\\b.c\\d 665} a\\b.c\\d 666test cmdAH-10.34 {Tcl_FileObjCmd: rootname} testsetplatform { 667 testsetplatform windows 668 file rootname a\\b.c\\ 669} a\\b.c\\ 670set num 35 671foreach outer { {} a .a a. a.a } { 672 foreach inner { {} a .a a. a.a } { 673 set thing [format %s/%s $outer $inner] 674 ;test cmdAH-10.$num {Tcl_FileObjCmd: rootname and extension options} testsetplatform " 675 testsetplatform unix 676 [list format %s%s [file rootname $thing] [file ext $thing]] 677 " $thing 678 incr num 679 } 680} 681 682# extension 683test cmdAH-11.1 {Tcl_FileObjCmd: extension} -returnCodes error -body { 684 file extension a b 685} -result {wrong # args: should be "file extension name"} 686test cmdAH-11.2 {Tcl_FileObjCmd: extension} testsetplatform { 687 testsetplatform unix 688 file extension {} 689} {} 690test cmdAH-11.3 {Tcl_FileObjCmd: extension} testsetplatform { 691 testsetplatform unix 692 file ext foo 693} {} 694test cmdAH-11.4 {Tcl_FileObjCmd: extension} testsetplatform { 695 testsetplatform unix 696 file extension foo. 697} . 698test cmdAH-11.5 {Tcl_FileObjCmd: extension} testsetplatform { 699 testsetplatform unix 700 file extension .foo 701} .foo 702test cmdAH-11.6 {Tcl_FileObjCmd: extension} testsetplatform { 703 testsetplatform unix 704 file extension abc.def 705} .def 706test cmdAH-11.7 {Tcl_FileObjCmd: extension} testsetplatform { 707 testsetplatform unix 708 file extension abc.def.ghi 709} .ghi 710test cmdAH-11.8 {Tcl_FileObjCmd: extension} testsetplatform { 711 testsetplatform unix 712 file extension a/b/c.d 713} .d 714test cmdAH-11.9 {Tcl_FileObjCmd: extension} testsetplatform { 715 testsetplatform unix 716 file extension a/b.c/d 717} {} 718test cmdAH-11.10 {Tcl_FileObjCmd: extension} testsetplatform { 719 testsetplatform unix 720 file extension a/b.c/ 721} {} 722test cmdAH-11.23 {Tcl_FileObjCmd: extension} testsetplatform { 723 testsetplatform windows 724 file extension {} 725} {} 726test cmdAH-11.24 {Tcl_FileObjCmd: extension} testsetplatform { 727 testsetplatform windows 728 file ext foo 729} {} 730test cmdAH-11.25 {Tcl_FileObjCmd: extension} testsetplatform { 731 testsetplatform windows 732 file extension foo. 733} . 734test cmdAH-11.26 {Tcl_FileObjCmd: extension} testsetplatform { 735 testsetplatform windows 736 file extension .foo 737} .foo 738test cmdAH-11.27 {Tcl_FileObjCmd: extension} testsetplatform { 739 testsetplatform windows 740 file extension abc.def 741} .def 742test cmdAH-11.28 {Tcl_FileObjCmd: extension} testsetplatform { 743 testsetplatform windows 744 file extension abc.def.ghi 745} .ghi 746test cmdAH-11.29 {Tcl_FileObjCmd: extension} testsetplatform { 747 testsetplatform windows 748 file extension a/b/c.d 749} .d 750test cmdAH-11.30 {Tcl_FileObjCmd: extension} testsetplatform { 751 testsetplatform windows 752 file extension a/b.c/d 753} {} 754test cmdAH-11.31 {Tcl_FileObjCmd: extension} testsetplatform { 755 testsetplatform windows 756 file extension a\\b.c\\ 757} {} 758test cmdAH-11.32 {Tcl_FileObjCmd: extension} testsetplatform { 759 testsetplatform windows 760 file extension a\\b\\c.d 761} .d 762test cmdAH-11.33 {Tcl_FileObjCmd: extension} testsetplatform { 763 testsetplatform windows 764 file extension a\\b.c\\d 765} {} 766test cmdAH-11.34 {Tcl_FileObjCmd: extension} testsetplatform { 767 testsetplatform windows 768 file extension a\\b.c\\ 769} {} 770foreach {test onPlatform value result} { 771 cmdAH-11.35 unix a..b .b 772 cmdAH-11.36 windows a..b .b 773 cmdAH-11.37 unix a...b .b 774 cmdAH-11.38 windows a...b .b 775 cmdAH-11.39 unix a.c..b .b 776 cmdAH-11.40 windows a.c..b .b 777 cmdAH-11.41 unix ..b .b 778 cmdAH-11.42 windows ..b .b 779} { 780 test $test {Tcl_FileObjCmd: extension} testsetplatform " 781 testsetplatform $onPlatform 782 file extension $value 783 " $result 784} 785 786# pathtype 787test cmdAH-12.1 {Tcl_FileObjCmd: pathtype} -returnCodes error -body { 788 file pathtype a b 789} -result {wrong # args: should be "file pathtype name"} 790test cmdAH-12.2 {Tcl_FileObjCmd: pathtype} testsetplatform { 791 testsetplatform unix 792 file pathtype /a 793} absolute 794test cmdAH-12.3 {Tcl_FileObjCmd: pathtype} testsetplatform { 795 testsetplatform unix 796 file p a 797} relative 798test cmdAH-12.4 {Tcl_FileObjCmd: pathtype} testsetplatform { 799 testsetplatform windows 800 file pathtype c:a 801} volumerelative 802 803# split 804test cmdAH-13.1 {Tcl_FileObjCmd: split} -returnCodes error -body { 805 file split a b 806} -result {wrong # args: should be "file split name"} 807test cmdAH-13.2 {Tcl_FileObjCmd: split} testsetplatform { 808 testsetplatform unix 809 file split a 810} a 811test cmdAH-13.3 {Tcl_FileObjCmd: split} testsetplatform { 812 testsetplatform unix 813 file split a/b 814} {a b} 815 816# join 817test cmdAH-14.1 {Tcl_FileObjCmd: join} testsetplatform { 818 testsetplatform unix 819 file join a 820} a 821test cmdAH-14.2 {Tcl_FileObjCmd: join} testsetplatform { 822 testsetplatform unix 823 file join a b 824} a/b 825test cmdAH-14.3 {Tcl_FileObjCmd: join} testsetplatform { 826 testsetplatform unix 827 file join a b c d 828} a/b/c/d 829 830# error handling of Tcl_TranslateFileName 831test cmdAH-15.1 {Tcl_FileObjCmd} -constraints testsetplatform -body { 832 testsetplatform unix 833 file atime ~_bad_user 834} -returnCodes error -result {user "_bad_user" doesn't exist} 835 836catch {testsetplatform $platform} 837 838# readable 839set gorpfile [makeFile abcde gorp.file] 840set dirfile [makeDirectory dir.file] 841test cmdAH-16.1 {Tcl_FileObjCmd: readable} { 842 -returnCodes error 843 -body {file readable a b} 844 -result {wrong # args: should be "file readable name"} 845} 846test cmdAH-16.2 {Tcl_FileObjCmd: readable} { 847 -constraints testchmod 848 -setup {testchmod 0o444 $gorpfile} 849 -body {file readable $gorpfile} 850 -result 1 851} 852test cmdAH-16.3 {Tcl_FileObjCmd: readable} { 853 -constraints {unix notRoot testchmod} 854 -setup {testchmod 0o333 $gorpfile} 855 -body {file readable $gorpfile} 856 -result 0 857} 858 859# writable 860test cmdAH-17.1 {Tcl_FileObjCmd: writable} { 861 -returnCodes error 862 -body {file writable a b} 863 -result {wrong # args: should be "file writable name"} 864} 865test cmdAH-17.2 {Tcl_FileObjCmd: writable} { 866 -constraints {notRoot testchmod} 867 -setup {testchmod 0o555 $gorpfile} 868 -body {file writable $gorpfile} 869 -result 0 870} 871test cmdAH-17.3 {Tcl_FileObjCmd: writable} { 872 -constraints testchmod 873 -setup {testchmod 0o222 $gorpfile} 874 -body {file writable $gorpfile} 875 -result 1 876} 877 878# executable 879removeFile $gorpfile 880removeDirectory $dirfile 881set dirfile [makeDirectory dir.file] 882set gorpfile [makeFile abcde gorp.file] 883test cmdAH-18.1 {Tcl_FileObjCmd: executable} -returnCodes error -body { 884 file executable a b 885} -result {wrong # args: should be "file executable name"} 886test cmdAH-18.2 {Tcl_FileObjCmd: executable} {notRoot} { 887 file executable $gorpfile 888} 0 889test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} { 890 # Only on unix will setting the execute bit on a regular file cause that 891 # file to be executable. 892 testchmod 0o775 $gorpfile 893 file exe $gorpfile 894} 1 895test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body { 896 # On windows, must be a .exe, .com, etc. 897 set x {} 898 set gorpexes {} 899 foreach ext {exe com cmd bat} { 900 lappend x [file exe nosuchfile.$ext] 901 set gorpexe [makeFile foo gorp.$ext] 902 lappend gorpexes $gorpexe 903 lappend x [file exe $gorpexe] [file exe [string toupper $gorpexe]] 904 } 905 set x 906} -cleanup { 907 foreach gorpexe $gorpexes { 908 removeFile $gorpexe 909 } 910} -result {0 1 1 0 1 1 0 1 1 0 1 1} 911test cmdAH-18.6 {Tcl_FileObjCmd: executable} {} { 912 # Directories are always executable. 913 file exe $dirfile 914} 1 915 916removeDirectory $dirfile 917removeFile $gorpfile 918set linkfile [file join [temporaryDirectory] link.file] 919file delete $linkfile 920 921# exists 922test cmdAH-19.1 {Tcl_FileObjCmd: exists} -returnCodes error -body { 923 file exists a b 924} -result {wrong # args: should be "file exists name"} 925test cmdAH-19.2 {Tcl_FileObjCmd: exists} {file exists $gorpfile} 0 926test cmdAH-19.3 {Tcl_FileObjCmd: exists} { 927 file exists [file join [temporaryDirectory] dir.file gorp.file] 928} 0 929catch { 930 set gorpfile [makeFile abcde gorp.file] 931 set dirfile [makeDirectory dir.file] 932 set subgorp [makeFile 12345 [file join $dirfile gorp.file]] 933} 934test cmdAH-19.4 {Tcl_FileObjCmd: exists} { 935 file exists $gorpfile 936} 1 937test cmdAH-19.5 {Tcl_FileObjCmd: exists} { 938 file exists $subgorp 939} 1 940# nativename 941test cmdAH-19.6 {Tcl_FileObjCmd: nativename} -body { 942 testsetplatform unix 943 file nativename a/b 944} -constraints testsetplatform -cleanup { 945 testsetplatform $platform 946} -result a/b 947test cmdAH-19.7 {Tcl_FileObjCmd: nativename} -body { 948 testsetplatform windows 949 file nativename a/b 950} -constraints testsetplatform -cleanup { 951 testsetplatform $platform 952} -result {a\b} 953test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} { 954 file exists ~nOsUcHuSeR 955} 0 956test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} -body { 957 # should probably be a non-error in fact... 958 file nativename ~nOsUcHuSeR 959} -returnCodes error -match glob -result * 960# The test below has to be done in /tmp rather than the current directory in 961# order to guarantee (?) a local file system: some NFS file systems won't do 962# the stuff below correctly. 963test cmdAH-19.11 {Tcl_FileObjCmd: exists} -constraints {unix notRoot} -setup { 964 file delete -force /tmp/tcl.foo.dir/file 965 file delete -force /tmp/tcl.foo.dir 966} -body { 967 makeDirectory /tmp/tcl.foo.dir 968 makeFile 12345 /tmp/tcl.foo.dir/file 969 file attributes /tmp/tcl.foo.dir -permissions 0 970 file exists /tmp/tcl.foo.dir/file 971} -cleanup { 972 file attributes /tmp/tcl.foo.dir -permissions 0o775 973 removeFile /tmp/tcl.foo.dir/file 974 removeDirectory /tmp/tcl.foo.dir 975} -result 0 976test cmdAH-19.12 {Bug 3608360: [file exists] mustn't do globbing} -setup { 977 set newdirfile [makeDirectory newdir.file] 978 set cwd [pwd] 979 cd $newdirfile 980 # Content of file is totally unimportant; name is *not* 981 set innocentBystander [makeFile "abc" [file join $newdirfile foo.bar]] 982} -body { 983 list [file exists foo.bar] [file exists *.bar] 984} -cleanup { 985 cd $cwd 986 removeFile $innocentBystander 987 removeDirectory $newdirfile 988} -result {1 0} 989 990# Stat related commands 991 992catch {testsetplatform $platform} 993removeFile $gorpfile 994set gorpfile [makeFile "Test string" gorp.file] 995catch {file attributes $gorpfile -permissions 0o765} 996 997# avoid problems with non-local filesystems 998if {[testConstraint unix] && [file exists /tmp]} { 999 set file [makeFile "data" touch.me /tmp] 1000} else { 1001 set file [makeFile "data" touch.me] 1002} 1003 1004# atime 1005test cmdAH-20.1 {Tcl_FileObjCmd: atime} -returnCodes error -body { 1006 file atime a b c 1007} -result {wrong # args: should be "file atime name ?time?"} 1008test cmdAH-20.2 {Tcl_FileObjCmd: atime} -setup { 1009 unset -nocomplain stat 1010} -body { 1011 file stat $gorpfile stat 1012 list [expr {[file mtime $gorpfile] == $stat(mtime)}] \ 1013 [expr {[file atime $gorpfile] == $stat(atime)}] 1014} -result {1 1} 1015test cmdAH-20.3 {Tcl_FileObjCmd: atime} { 1016 list [catch {file atime _bogus_} msg] [string tolower $msg] $errorCode 1017} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} 1018test cmdAH-20.4 {Tcl_FileObjCmd: atime} -returnCodes error -body { 1019 file atime $file notint 1020} -result {expected integer but got "notint"} 1021test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {unix} { 1022 set atime [file atime $file] 1023 after 1100; # pause a sec to notice change in atime 1024 set newatime [clock seconds] 1025 set modatime [file atime $file $newatime] 1026 expr {$newatime == $modatime ? 1 : "$newatime != $modatime"} 1027} 1 1028test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} -setup { 1029 set old [pwd] 1030 cd $::tcltest::temporaryDirectory 1031 set volumetype [testvolumetype] 1032 cd $old 1033} -constraints {win testvolumetype} -body { 1034 if {"NTFS" ne $volumetype} { 1035 # Windows FAT doesn't understand atime, but NTFS does. May also fail 1036 # for Windows on NFS mounted disks. 1037 return 1 1038 } 1039 cd $old 1040 set atime [file atime $file] 1041 after 1100; # pause a sec to notice change in atime 1042 set newatime [clock seconds] 1043 set modatime [file atime $file $newatime] 1044 expr {$newatime == $modatime ? 1 : "$newatime != $modatime"} 1045} -result 1 1046test cmdAH-20.7 { 1047 Tcl_FileObjCmd: atime (built-in Windows names) 1048} -constraints {win} -body { 1049 file atime con 1050} -result "could not get access time for file \"con\"" -returnCodes error 1051test cmdAH-20.7.1 { 1052 Tcl_FileObjCmd: atime (built-in Windows names with dir path and extension) 1053} -constraints {win} -body { 1054 file atime [file join [temporaryDirectory] CON.txt] 1055} -match regexp -result {could not (?:get access time|read)} -returnCodes error 1056 1057if {[testConstraint unix] && [file exists /tmp]} { 1058 removeFile touch.me /tmp 1059} else { 1060 removeFile touch.me 1061} 1062 1063# isdirectory 1064test cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} -returnCodes error -body { 1065 file isdirectory a b 1066} -result {wrong # args: should be "file isdirectory name"} 1067test cmdAH-21.2 {Tcl_FileObjCmd: isdirectory} {file isdirectory $gorpfile} 0 1068test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {file isdirectory $dirfile} 1 1069 1070# isfile 1071test cmdAH-22.1 {Tcl_FileObjCmd: isfile} -returnCodes error -body { 1072 file isfile a b 1073} -result {wrong # args: should be "file isfile name"} 1074test cmdAH-22.2 {Tcl_FileObjCmd: isfile} {file isfile $gorpfile} 1 1075test cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile $dirfile} 0 1076 1077# lstat and readlink: don't run these tests everywhere, since not all sites 1078# will have symbolic links 1079catch {file link -symbolic $linkfile $gorpfile} 1080test cmdAH-23.1 {Tcl_FileObjCmd: lstat} -returnCodes error -body { 1081 file lstat a 1082} -result {wrong # args: should be "file lstat name varName"} 1083test cmdAH-23.2 {Tcl_FileObjCmd: lstat} -returnCodes error -body { 1084 file lstat a b c 1085} -result {wrong # args: should be "file lstat name varName"} 1086test cmdAH-23.3 {Tcl_FileObjCmd: lstat} -setup { 1087 unset -nocomplain stat 1088} -constraints {unix nonPortable} -body { 1089 file lstat $linkfile stat 1090 lsort [array names stat] 1091} -result {atime ctime dev gid ino mode mtime nlink size type uid} 1092test cmdAH-23.4 {Tcl_FileObjCmd: lstat} -setup { 1093 unset -nocomplain stat 1094} -constraints {unix nonPortable} -body { 1095 file lstat $linkfile stat 1096 list $stat(nlink) [expr {$stat(mode) & 0o777}] $stat(type) 1097} -result {1 511 link} 1098test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} { 1099 list [catch {file lstat _bogus_ stat} msg] [string tolower $msg] \ 1100 $errorCode 1101} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} 1102test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} -setup { 1103 unset -nocomplain x 1104} -body { 1105 set x 44 1106 list [catch {file lstat $gorpfile x} msg] $msg $errorCode 1107} -result {1 {can't set "x(dev)": variable isn't array} {TCL LOOKUP VARNAME x}} 1108unset -nocomplain stat 1109# mkdir 1110set dirA [file join [temporaryDirectory] a] 1111set dirB [file join [temporaryDirectory] a] 1112test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} -setup { 1113 catch {file delete -force $dirA} 1114} -body { 1115 file mkdir $dirA 1116 file isdirectory $dirA 1117} -cleanup { 1118 file delete $dirA 1119} -result {1} 1120test cmdAH-23.8 {Tcl_FileObjCmd: mkdir} -setup { 1121 catch {file delete -force $dirA} 1122} -body { 1123 file mkdir $dirA/b 1124 file isdirectory $dirA/b 1125} -cleanup { 1126 file delete -force $dirA 1127} -result {1} 1128test cmdAH-23.9 {Tcl_FileObjCmd: mkdir} -setup { 1129 catch {file delete -force $dirA} 1130} -body { 1131 file mkdir $dirA/b/c 1132 file isdirectory $dirA/b/c 1133} -cleanup { 1134 file delete -force $dirA 1135} -result {1} 1136test cmdAH-23.10 {Tcl_FileObjCmd: mkdir} -setup { 1137 catch {file delete -force $dirA} 1138 catch {file delete -force $dirB} 1139} -body { 1140 file mkdir $dirA/b $dirB/a/c 1141 list [file isdirectory $dirA/b] [file isdirectory $dirB/a/c] 1142} -cleanup { 1143 file delete -force $dirA 1144 file delete -force $dirB 1145} -result {1 1} 1146test cmdAH-23.11 {Tcl_FileObjCmd: mkdir} { 1147 # Allow zero arguments (TIP 323) 1148 file mkdir 1149} {} 1150 1151set file [makeFile "data" touch.me] 1152# mtime 1153test cmdAH-24.1 {Tcl_FileObjCmd: mtime} -returnCodes error -body { 1154 file mtime a b c 1155} -result {wrong # args: should be "file mtime name ?time?"} 1156test cmdAH-24.2 {Tcl_FileObjCmd: mtime} -setup { 1157 # Check (allowing for clock-skew and OS interrupts as best we can) that 1158 # the change in mtime on a file being written is the time elapsed between 1159 # writes. Note that this can still fail on very busy systems if there are 1160 # long preemptions between the writes and the reading of the clock, but 1161 # there's not much you can do about that other than the completely 1162 # horrible "keep on trying to write until you managed to do it all in less 1163 # than a second." - DKF 1164 waitForEvenSecondForFAT 1165} -body { 1166 set f [open $gorpfile w] 1167 puts $f "More text" 1168 close $f 1169 set clockOld [clock seconds] 1170 set fileOld [file mtime $gorpfile] 1171 after 2000 1172 set f [open $gorpfile w] 1173 puts $f "More text" 1174 close $f 1175 set clockNew [clock seconds] 1176 set fileNew [file mtime $gorpfile] 1177 expr { 1178 (($fileNew > $fileOld) && ($clockNew > $clockOld) && 1179 (abs(($fileNew-$fileOld) - ($clockNew-$clockOld)) <= 1)) ? "1" : 1180 "file:($fileOld=>$fileNew) clock:($clockOld=>$clockNew)" 1181 } 1182} -result {1} 1183test cmdAH-24.3 {Tcl_FileObjCmd: mtime} -setup { 1184 unset -nocomplain stat 1185} -body { 1186 file stat $gorpfile stat 1187 list [expr {[file mtime $gorpfile] == $stat(mtime)}] \ 1188 [expr {[file atime $gorpfile] == $stat(atime)}] 1189} -result {1 1} 1190test cmdAH-24.4 {Tcl_FileObjCmd: mtime} { 1191 list [catch {file mtime _bogus_} msg] [string tolower $msg] $errorCode 1192} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} 1193test cmdAH-24.5 {Tcl_FileObjCmd: mtime} -setup { 1194 # Under Unix, use a file in /tmp to avoid clock skew due to NFS. On other 1195 # platforms, just use a file in the local directory. 1196 if {[testConstraint unix]} { 1197 set name /tmp/tcl.test.[pid] 1198 } else { 1199 set name [file join [temporaryDirectory] tf] 1200 } 1201} -body { 1202 # Make sure that a new file's time is correct. 10 seconds variance is 1203 # allowed used due to slow networks or clock skew on a network drive. 1204 file delete -force $name 1205 close [open $name w] 1206 expr {abs([clock seconds]-[file mtime $name])<10} 1207} -cleanup { 1208 file delete $name 1209} -result {1} 1210test cmdAH-24.7 {Tcl_FileObjCmd: mtime} -returnCodes error -body { 1211 file mtime $file notint 1212} -result {expected integer but got "notint"} 1213test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} unix { 1214 set mtime [file mtime $file] 1215 after 1100; # pause a sec to notice change in mtime 1216 set newmtime [clock seconds] 1217 set modmtime [file mtime $file $newmtime] 1218 expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} 1219} 1 1220test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup { 1221 set oldfile $file 1222} -constraints unix -body { 1223 # introduce some non-ascii characters. 1224 append file • 1225 file delete -force $file 1226 file rename $oldfile $file 1227 set mtime [file mtime $file] 1228 after 1100; # pause a sec to notice change in mtime 1229 set newmtime [clock seconds] 1230 set modmtime [file mtime $file $newmtime] 1231 expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} 1232} -cleanup { 1233 file rename $file $oldfile 1234} -result 1 1235test cmdAH-24.10 {Tcl_FileObjCmd: mtime touch} -constraints win -setup { 1236 waitForEvenSecondForFAT 1237} -body { 1238 set mtime [file mtime $file] 1239 after 2100; # pause two secs to notice change in mtime on FAT fs'es 1240 set newmtime [clock seconds] 1241 set modmtime [file mtime $file $newmtime] 1242 expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} 1243} -result 1 1244test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup { 1245 waitForEvenSecondForFAT 1246 set oldfile $file 1247} -constraints win -body { 1248 # introduce some non-ascii characters. 1249 append file • 1250 file delete -force $file 1251 file rename $oldfile $file 1252 set mtime [file mtime $file] 1253 after 2100; # pause two secs to notice change in mtime on FAT fs'es 1254 set newmtime [clock seconds] 1255 set modmtime [file mtime $file $newmtime] 1256 expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"} 1257} -cleanup { 1258 file rename $file $oldfile 1259} -result 1 1260removeFile touch.me 1261rename waitForEvenSecondForFAT {} 1262test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} -setup { 1263 set name [file join [temporaryDirectory] clockchange] 1264 file delete -force $name 1265 close [open $name w] 1266} -body { 1267 set time [clock scan "21:00:00 October 30 2004 GMT"] 1268 file mtime $name $time 1269 set newmtime [file mtime $name] 1270 expr {$newmtime == $time ? 1 : "$newmtime != $time"} 1271} -cleanup { 1272 file delete $name 1273} -result {1} 1274# bug 1420432: setting mtime fails for directories on windows. 1275test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} -setup { 1276 set dirname [file join [temporaryDirectory] tmp[pid]] 1277 file delete -force $dirname 1278} -constraints tempNotWin -body { 1279 file mkdir $dirname 1280 set old [file mtime $dirname] 1281 file mtime $dirname 0 1282 set new [file mtime $dirname] 1283 list $new [expr {$old != $new}] 1284} -cleanup { 1285 file delete -force $dirname 1286} -result {0 1} 1287test cmdAH-24.14 { 1288 Tcl_FileObjCmd: mtime (built-in Windows names) 1289} -constraints {win} -body { 1290 file mtime con 1291} -result "could not get modification time for file \"con\"" -returnCodes error 1292test cmdAH-24.14.1 { 1293 Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension) 1294} -constraints {win} -body { 1295 file mtime [file join [temporaryDirectory] CON.txt] 1296} -match regexp -result {could not (?:get modification time|read)} -returnCodes error 1297 1298# 3155760000 is 64-bit unix time, Wed Jan 01 00:00:00 GMT 2070: 1299test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup { 1300 set filename [makeFile "" foo.text] 1301} -body { 1302 list [file atime $filename 3155760000] [file atime $filename] 1303} -cleanup { 1304 removeFile $filename 1305} -result {3155760000 3155760000} 1306test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup { 1307 set filename [makeFile "" foo.text] 1308} -body { 1309 list [file mtime $filename 3155760000] [file mtime $filename] 1310} -cleanup { 1311 file delete -force $filename 1312} -result {3155760000 3155760000} 1313 1314# owned 1315test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body { 1316 file owned a b 1317} -result {wrong # args: should be "file owned name"} 1318test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -setup { 1319 set fn $gorpfile 1320 # prefer temp file to check owner (try to avoid bug [7de2d722bd]): 1321 if { 1322 [info exists ::env(TEMP)] && [file isdirectory $::env(TEMP)] && 1323 [file dirname $fn] ne [file normalize $::env(TEMP)] 1324 } { 1325 set fn [file join $::env(TEMP)/test-owner-from-tcl.txt] 1326 set fn [makeFile "data" test-owner-from-tcl.txt $::env(TEMP)] 1327 } 1328 # be sure we have really owned this file before trying to check that 1329 # (avoid dependency on admin with UAC and the setting "System objects: 1330 # Default owner for objects created by members of the Administrators group"): 1331 catch { 1332 exec takeown /F [file nativename $fn] 1333 } 1334} -body { 1335 file owned $fn 1336} -cleanup { 1337 if {$fn ne $gorpfile} { 1338 removeFile $fn 1339 } 1340} -result 1 1341test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup { 1342 # Avoid problems with AFS 1343 set tmpfile [makeFile "data" touch.me /tmp] 1344} -body { 1345 file owned $tmpfile 1346} -cleanup { 1347 removeFile touch.me /tmp 1348} -result 1 1349test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} { 1350 file owned / 1351} 0 1352test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints {win notWine} -body { 1353 if {[info exists env(SystemRoot)]} { 1354 file owned $env(SystemRoot) 1355 } else { 1356 file owned $env(windir) 1357 } 1358} -result 0 1359test cmdAH-25.4 {Tcl_FileObjCmd: owned} -body { 1360 file owned nosuchfile 1361} -result 0 1362 1363# readlink 1364test cmdAH-26.1 {Tcl_FileObjCmd: readlink} -returnCodes error -body { 1365 file readlink a b 1366} -result {wrong # args: should be "file readlink name"} 1367test cmdAH-26.2 {Tcl_FileObjCmd: readlink} {unix nonPortable} { 1368 file readlink $linkfile 1369} $gorpfile 1370test cmdAH-26.3 {Tcl_FileObjCmd: readlink errors} {unix nonPortable} { 1371 list [catch {file readlink _bogus_} msg] [string tolower $msg] $errorCode 1372} {1 {could not readlink "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} 1373test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {win nonPortable} { 1374 list [catch {file readlink _bogus_} msg] [string tolower $msg] $errorCode 1375} {1 {could not readlink "_bogus_": invalid argument} {POSIX EINVAL {invalid argument}}} 1376 1377# size 1378test cmdAH-27.1 {Tcl_FileObjCmd: size} -returnCodes error -body { 1379 file size a b 1380} -result {wrong # args: should be "file size name"} 1381test cmdAH-27.2 {Tcl_FileObjCmd: size} { 1382 set oldsize [file size $gorpfile] 1383 set f [open $gorpfile a] 1384 fconfigure $f -translation lf -eofchar {} 1385 puts $f "More text" 1386 close $f 1387 expr {[file size $gorpfile] - $oldsize} 1388} {10} 1389test cmdAH-27.3 {Tcl_FileObjCmd: size} { 1390 list [catch {file size _bogus_} msg] [string tolower $msg] $errorCode 1391} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} 1392test cmdAH-27.4 { 1393 Tcl_FileObjCmd: size (built-in Windows names) 1394} -constraints {win} -body { 1395 file size con 1396} -result 0 1397test cmdAH-27.4.1 { 1398 Tcl_FileObjCmd: size (built-in Windows names with dir path and extension) 1399} -constraints {win} -body { 1400 try { 1401 set res [file size [file join [temporaryDirectory] con.txt]] 1402 } trap {POSIX ENOENT} {} { 1403 set res 0 1404 } 1405 set res 1406} -result 0 1407 1408catch {testsetplatform $platform} 1409removeFile $gorpfile 1410set gorpfile [makeFile "Test string" gorp.file] 1411catch {file attributes $gorpfile -permissions 0o765} 1412 1413# stat 1414test cmdAH-28.1 {Tcl_FileObjCmd: stat} -returnCodes error -body { 1415 file stat _bogus_ 1416} -result {wrong # args: should be "file stat name varName"} 1417test cmdAH-28.2 {Tcl_FileObjCmd: stat} -returnCodes error -body { 1418 file stat _bogus_ a b 1419} -result {wrong # args: should be "file stat name varName"} 1420test cmdAH-28.3 {Tcl_FileObjCmd: stat} -setup { 1421 unset -nocomplain stat 1422 set stat(blocks) [set stat(blksize) {}] 1423} -body { 1424 file stat $gorpfile stat 1425 unset stat(blocks) stat(blksize); # Ignore these fields; not always set 1426 lsort [array names stat] 1427} -result {atime ctime dev gid ino mode mtime nlink size type uid} 1428test cmdAH-28.4 {Tcl_FileObjCmd: stat} -setup { 1429 unset -nocomplain stat 1430} -body { 1431 file stat $gorpfile stat 1432 list $stat(nlink) $stat(size) $stat(type) 1433} -result {1 12 file} 1434test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix} -setup { 1435 unset -nocomplain stat 1436} -body { 1437 file stat $gorpfile stat 1438 format 0o%03o [expr {$stat(mode) & 0o777}] 1439} -result 0o765 1440test cmdAH-28.6 {Tcl_FileObjCmd: stat} { 1441 list [catch {file stat _bogus_ stat} msg] [string tolower $msg] $errorCode 1442} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} 1443test cmdAH-28.7 {Tcl_FileObjCmd: stat} -setup { 1444 unset -nocomplain x 1445} -returnCodes error -body { 1446 set x 44 1447 file stat $gorpfile x 1448} -result {can't set "x(dev)": variable isn't array} 1449test cmdAH-28.8 {Tcl_FileObjCmd: stat} -setup { 1450 set filename [makeFile "" foo.text] 1451} -body { 1452 # Sign extension of purported unsigned short to int. 1453 file stat $filename stat 1454 expr {$stat(mode) > 0} 1455} -cleanup { 1456 removeFile $filename 1457} -result 1 1458test cmdAH-28.9 {Tcl_FileObjCmd: stat} win { 1459 # stat of root directory was failing. Don't care about answer, just that 1460 # test runs. Relative paths that resolve to root 1461 set old [pwd] 1462 cd c:/ 1463 file stat c: stat 1464 file stat c:. stat 1465 file stat . stat 1466 cd $old 1467 file stat / stat 1468 file stat c:/ stat 1469 file stat c:/. stat 1470} {} 1471test cmdAH-28.10 {Tcl_FileObjCmd: stat} {win nonPortable} { 1472 # stat of root directory was failing. Don't care about answer, just that 1473 # test runs. 1474 file stat //pop/$env(USERNAME) stat 1475 file stat //pop/$env(USERNAME)/ stat 1476 file stat //pop/$env(USERNAME)/. stat 1477} {} 1478test cmdAH-28.11 {Tcl_FileObjCmd: stat} -setup { 1479 set old [pwd] 1480} -constraints {win nonPortable} -body { 1481 # stat of network directory was returning id of current local drive. 1482 cd c:/ 1483 file stat //pop/$env(USERNAME) stat 1484 expr {$stat(dev) == 2} 1485} -cleanup { 1486 cd $old 1487} -result 0 1488test cmdAH-28.12 {Tcl_FileObjCmd: stat} -setup { 1489 set filename [makeFile "" foo.test] 1490} -body { 1491 # stat(mode) with S_IFREG flag was returned as a negative number if mode_t 1492 # was a short instead of an unsigned short. 1493 file stat $filename stat 1494 expr {$stat(mode) > 0} 1495} -cleanup { 1496 removeFile $filename 1497} -result 1 1498test cmdAH-28.13 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {win} -setup { 1499 unset -nocomplain stat 1500} -body { 1501 file stat con stat 1502 lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)} 1503} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0} 1504test cmdAH-28.13.1 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {win} -setup { 1505 unset -nocomplain stat 1506} -body { 1507 try { 1508 file stat [file join [temporaryDirectory] CON.txt] stat 1509 set res [lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}] 1510 } trap {POSIX ENOENT} {} { 1511 set res {0 0 -1 0 0 8630 0 0 0 characterSpecial 0} 1512 } 1513 set res 1514} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0} 1515unset -nocomplain stat 1516 1517# type 1518test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body { 1519 file type a b 1520} -result {wrong # args: should be "file type name"} 1521test cmdAH-29.2 {Tcl_FileObjCmd: type} { 1522 file type $dirfile 1523} directory 1524test cmdAH-29.3.0 {Tcl_FileObjCmd: delete removes link not file} {unix nonPortable} { 1525 set exists [list [file exists $linkfile] [file exists $gorpfile]] 1526 file delete $linkfile 1527 set exists2 [list [file exists $linkfile] [file exists $gorpfile]] 1528 list $exists $exists2 1529} {{1 1} {0 1}} 1530test cmdAH-29.3 {Tcl_FileObjCmd: type} { 1531 file type $gorpfile 1532} file 1533test cmdAH-29.4 {Tcl_FileObjCmd: type} -constraints {unix} -setup { 1534 catch {file delete $linkfile} 1535} -body { 1536 # Unlike [exec ln -s], [file link] requires an existing target 1537 file link -symbolic $linkfile $gorpfile 1538 file type $linkfile 1539} -cleanup { 1540 file delete $linkfile 1541} -result link 1542test cmdAH-29.4.1 {Tcl_FileObjCmd: type} -constraints {linkDirectory notWine} -setup { 1543 set tempdir [makeDirectory temp] 1544} -body { 1545 set linkdir [file join [temporaryDirectory] link.dir] 1546 file link -symbolic $linkdir $tempdir 1547 file type $linkdir 1548} -cleanup { 1549 file delete $linkdir 1550 removeDirectory $tempdir 1551} -result link 1552test cmdAH-29.5 {Tcl_FileObjCmd: type} { 1553 list [catch {file type _bogus_} msg] [string tolower $msg] $errorCode 1554} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}} 1555test cmdAH-29.6 { 1556 Tcl_FileObjCmd: type (built-in Windows names) 1557} -constraints {win} -body { 1558 file type con 1559} -result "characterSpecial" 1560test cmdAH-29.6.1 { 1561 Tcl_FileObjCmd: type (built-in Windows names, with dir path and extension) 1562} -constraints {win} -body { 1563 try { 1564 set res [file type [file join [temporaryDirectory] CON.txt]] 1565 } trap {POSIX ENOENT} {} { 1566 set res {characterSpecial} 1567 } 1568 set res 1569} -result "characterSpecial" 1570 1571# Error conditions 1572test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { 1573 file gorp x 1574} -result {unknown or ambiguous subcommand "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, type, volumes, or writable} 1575test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { 1576 file ex x 1577} -match glob -result {unknown or ambiguous subcommand "ex": must be *} 1578test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { 1579 file is x 1580} -match glob -result {unknown or ambiguous subcommand "is": must be *} 1581test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { 1582 file z x 1583} -match glob -result {unknown or ambiguous subcommand "z": must be *} 1584test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { 1585 file read x 1586} -match glob -result {unknown or ambiguous subcommand "read": must be *} 1587test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { 1588 file s x 1589} -match glob -result {unknown or ambiguous subcommand "s": must be *} 1590test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { 1591 file t x 1592} -match glob -result {unknown or ambiguous subcommand "t": must be *} 1593test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} -returnCodes error -body { 1594 file dirname ~woohgy 1595} -result {user "woohgy" doesn't exist} 1596 1597# channels 1598# In testing 'file channels', we need to make sure that a channel created in 1599# one interp isn't visible in another. 1600 1601interp create simpleInterp 1602interp create -safe safeInterp 1603interp create 1604catch {safeInterp expose file file} 1605 1606test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} -body { 1607 file channels a b 1608} -returnCodes error -result {wrong # args: should be "file channels ?pattern?"} 1609test cmdAH-31.2 {Tcl_FileObjCmd: channels, too many args} { 1610 # Normal interps start out with only the standard channels 1611 lsort [simpleInterp eval [list file chan]] 1612} {stderr stdin stdout} 1613test cmdAH-31.3 {Tcl_FileObjCmd: channels, globbing} { 1614 string equal [file channels] [file channels *] 1615} {1} 1616test cmdAH-31.4 {Tcl_FileObjCmd: channels, globbing} { 1617 lsort [file channels std*] 1618} {stderr stdin stdout} 1619set newFileId [open $gorpfile w] 1620test cmdAH-31.5 {Tcl_FileObjCmd: channels} { 1621 set res [file channels $newFileId] 1622 string equal $newFileId $res 1623} {1} 1624test cmdAH-31.6 {Tcl_FileObjCmd: channels in other interp} { 1625 # Safe interps start out with no channels 1626 safeInterp eval [list file channels] 1627} {} 1628test cmdAH-31.7 {Tcl_FileObjCmd: channels in other interp} -body { 1629 safeInterp eval [list puts $newFileId "hello"] 1630} -returnCodes error -result "can not find channel named \"$newFileId\"" 1631interp share {} $newFileId safeInterp 1632interp share {} stdout safeInterp 1633test cmdAH-31.8 {Tcl_FileObjCmd: channels in other interp} { 1634 # $newFileId should now be visible in both interps 1635 list [file channels $newFileId] \ 1636 [safeInterp eval [list file channels $newFileId]] 1637} [list $newFileId $newFileId] 1638test cmdAH-31.9 {Tcl_FileObjCmd: channels in other interp} { 1639 lsort [safeInterp eval [list file channels]] 1640} [lsort [list stdout $newFileId]] 1641test cmdAH-31.10 {Tcl_FileObjCmd: channels in other interp} { 1642 # we can now write to $newFileId from child 1643 safeInterp eval [list puts $newFileId "hello"] 1644} {} 1645interp transfer {} $newFileId safeInterp 1646test cmdAH-31.11 {Tcl_FileObjCmd: channels in other interp} { 1647 # $newFileId should now be visible only in safeInterp 1648 list [file channels $newFileId] \ 1649 [safeInterp eval [list file channels $newFileId]] 1650} [list {} $newFileId] 1651test cmdAH-31.12 {Tcl_FileObjCmd: channels in other interp} { 1652 lsort [safeInterp eval [list file channels]] 1653} [lsort [list stdout $newFileId]] 1654test cmdAH-31.13 {Tcl_FileObjCmd: channels in other interp} { 1655 safeInterp eval [list close $newFileId] 1656 safeInterp eval [list file channels] 1657} {stdout} 1658 1659# Temp files (TIP#210) 1660test cmdAH-32.1 {file tempfile - usage} -returnCodes error -body { 1661 file tempfile a b c 1662} -result {wrong # args: should be "file tempfile ?nameVar? ?template?"} 1663test cmdAH-32.2 {file tempfile - returns a read/write channel} -body { 1664 set f [file tempfile] 1665 puts $f ok 1666 seek $f 0 1667 gets $f 1668} -cleanup { 1669 catch {close $f} 1670} -result ok 1671test cmdAH-32.3 {file tempfile - makes filenames} -setup { 1672 unset -nocomplain name 1673} -body { 1674 set result [info exists name] 1675 set f [file tempfile name] 1676 lappend result [info exists name] [file exists $name] 1677 close $f 1678 lappend result [file exists $name] 1679} -cleanup { 1680 catch {close $f} 1681 catch {file delete $name} 1682} -result {0 1 1 1} 1683# We try to obey the template on Unix, but don't (currently) bother on Win 1684test cmdAH-32.4 {file tempfile - templates} -constraints unix -body { 1685 close [file tempfile name foo] 1686 expr {[string match foo* [file tail $name]] ? "ok" : "foo produced $name"} 1687} -cleanup { 1688 catch {file delete $name} 1689} -result ok 1690test cmdAH-32.5 {file tempfile - templates} -constraints unix -body { 1691 set template [file join $dirfile foo] 1692 close [file tempfile name $template] 1693 expr {[string match $template* $name] ? "ok" : "$template produced $name"} 1694} -cleanup { 1695 catch {file delete $name} 1696} -result ok 1697# Not portable; not all unix systems have mkstemps() 1698test cmdAH-32.6 {file tempfile - templates} -body { 1699 set template [file join $dirfile foo] 1700 close [file tempfile name $template.bar] 1701 expr {[string match $template*.bar $name] ? "ok" : 1702 "$template.bar produced $name"} 1703} -constraints {unix nonPortable} -cleanup { 1704 catch {file delete $name} 1705} -result ok 1706 1707test cmdAH-33.1 {file tempdir} -body { 1708 file tempdir a b 1709} -returnCodes error -result {wrong # args: should be "file tempdir ?template?"} 1710test cmdAH-33.2 {file tempdir} -body { 1711 set d [file tempdir] 1712 list [file tail $d] [file exists $d] [file type $d] \ 1713 [glob -nocomplain -directory $d *] 1714} -match glob -result {tcl_* 1 directory {}} -cleanup { 1715 catch {file delete $d} 1716} 1717test cmdAH-33.3 {file tempdir} -body { 1718 set d [file tempdir gorp] 1719 list [file tail $d] [file exists $d] [file type $d] \ 1720 [glob -nocomplain -directory $d *] 1721} -match glob -result {gorp_* 1 directory {}} -cleanup { 1722 catch {file delete $d} 1723} 1724test cmdAH-33.4 {file tempdir} -setup { 1725 set base [file join [temporaryDirectory] gorp] 1726 file mkdir $base 1727} -body { 1728 set pre [glob -nocomplain -directory $base *] 1729 set d [file normalize [file tempdir $base/]] 1730 list [string map [list $base GORP:] $d] [file exists $d] [file type $d] \ 1731 $pre [glob -nocomplain -directory $d *] 1732} -match glob -result {GORP:/tcl_* 1 directory {} {}} -cleanup { 1733 catch {file delete -force $base} 1734} 1735test cmdAH-33.5 {file tempdir} -setup { 1736 set base [file join [temporaryDirectory] gorp] 1737 file mkdir $base 1738} -body { 1739 set pre [glob -nocomplain -directory $base *] 1740 set d [file normalize [file tempdir $base/gorp]] 1741 list [string map [list $base GORP:] $d] [file exists $d] [file type $d] \ 1742 $pre [glob -nocomplain -directory $d *] 1743} -match glob -result {GORP:/gorp_* 1 directory {} {}} -cleanup { 1744 catch {file delete -force $base} 1745} 1746test cmdAH-33.6 {file tempdir: missing parent dir} -setup { 1747 set base [file join [temporaryDirectory] gorp] 1748 file mkdir $base 1749} -returnCodes error -body { 1750 file tempdir $base/quux/ 1751} -cleanup { 1752 catch {file delete -force $base} 1753} -result {can't create temporary directory: no such file or directory} 1754test cmdAH-33.7 {file tempdir: missing parent dir} -setup { 1755 set base [file join [temporaryDirectory] gorp] 1756 file mkdir $base 1757} -returnCodes error -body { 1758 file tempdir $base/quux/foobar 1759} -cleanup { 1760 catch {file delete -force $base} 1761} -result {can't create temporary directory: no such file or directory} 1762 1763# This shouldn't work, but just in case a test above failed... 1764catch {close $newFileId} 1765 1766interp delete safeInterp 1767interp delete simpleInterp 1768 1769# cleanup 1770catch {testsetplatform $platform} 1771unset -nocomplain platform 1772 1773# Tcl_ForObjCmd is tested in for.test 1774 1775catch {file attributes $dirfile -permissions 0o777} 1776removeDirectory $dirfile 1777removeFile $gorpfile 1778# No idea how well [removeFile] copes with links... 1779file delete $linkfile 1780 1781cd $cmdAHwd 1782 1783::tcltest::cleanupTests 1784return 1785 1786# Local Variables: 1787# mode: tcl 1788# End: 1789