Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/cmdAH.test@260cb5ec6c19

     1 # The file tests the tclCmdAH.c file.

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) 1996-1998 by Sun Microsystems, Inc.

     8 # Copyright (c) 1998-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: cmdAH.test,v 1.30.2.6 2006/10/01 13:17:34 patthoyts Exp $

    15 if {[lsearch [namespace children] ::tcltest] == -1} {

    16     package require tcltest 2.1

    17     namespace import -force ::tcltest::*

    18 }

    20 tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]]

    22 global env

    23 set cmdAHwd [pwd]

    24 catch {set platform [testgetplatform]}

    26 test cmdAH-0.1 {Tcl_BreakObjCmd, errors} {

    27     list [catch {break foo} msg] $msg

    28 } {1 {wrong # args: should be "break"}}

    29 test cmdAH-0.2 {Tcl_BreakObjCmd, success} {

    30     list [catch {break} msg] $msg

    31 } {3 {}}

    33 # Tcl_CaseObjCmd is tested in case.test

    35 test cmdAH-1.1 {Tcl_CatchObjCmd, errors} {

    36     list [catch {catch} msg] $msg

    37 } {1 {wrong # args: should be "catch command ?varName?"}}

    38 test cmdAH-1.2 {Tcl_CatchObjCmd, errors} {

    39     list [catch {catch foo bar baz} msg] $msg

    40 } {1 {wrong # args: should be "catch command ?varName?"}}

    42 test cmdAH-2.1 {Tcl_CdObjCmd} {

    43     list [catch {cd foo bar} msg] $msg

    44 } {1 {wrong # args: should be "cd ?dirName?"}}

    45 set foodir [file join [temporaryDirectory] foo]

    46 test cmdAH-2.2 {Tcl_CdObjCmd} {

    47     file delete -force $foodir

    48     file mkdir $foodir

    49     cd $foodir

    50     set result [file tail [pwd]]

    51     cd ..

    52     file delete $foodir

    53     set result

    54 } foo

    55 test cmdAH-2.3 {Tcl_CdObjCmd} {

    56     global env

    57     set oldpwd [pwd]

    58     set temp $env(HOME)

    59     set env(HOME) $oldpwd

    60     file delete -force $foodir

    61     file mkdir $foodir

    62     cd $foodir

    63     cd ~

    64     set result [string equal [pwd] $oldpwd]

    65     file delete $foodir

    66     set env(HOME) $temp

    67     set result

    68 } 1

    69 test cmdAH-2.4 {Tcl_CdObjCmd} {

    70     global env

    71     set oldpwd [pwd]

    72     set temp $env(HOME)

    73     set env(HOME) $oldpwd

    74     file delete -force $foodir

    75     file mkdir $foodir

    76     cd $foodir

    77     cd

    78     set result [string equal [pwd] $oldpwd]

    79     file delete $foodir

    80     set env(HOME) $temp

    81     set result

    82 } 1

    83 test cmdAH-2.5 {Tcl_CdObjCmd} {

    84     list [catch {cd ~~} msg] $msg

    85 } {1 {user "~" doesn't exist}}

    86 test cmdAH-2.6 {Tcl_CdObjCmd} {

    87     list [catch {cd _foobar} msg] $msg

    88 } {1 {couldn't change working directory to "_foobar": no such file or directory}}

    89 test cmdAH-2.6.1 {Tcl_CdObjCmd} {

    90     list [catch {cd ""} msg] $msg

    91 } {1 {couldn't change working directory to "": no such file or directory}}

    93 test cmdAH-2.7 {Tcl_ConcatObjCmd} {

    94     concat

    95 } {}

    96 test cmdAH-2.8 {Tcl_ConcatObjCmd} {

    97     concat a

    98 } a

    99 test cmdAH-2.9 {Tcl_ConcatObjCmd} {

   100     concat a {b c}

   101 } {a b c}

   103 test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} {

   104     list [catch {continue foo} msg] $msg

   105 } {1 {wrong # args: should be "continue"}}

   106 test cmdAH-3.2 {Tcl_ContinueObjCmd, success} {

   107     list [catch {continue} msg] $msg

   108 } {4 {}}

   110 test cmdAH-4.1 {Tcl_EncodingObjCmd} {

   111     list [catch {encoding} msg] $msg

   112 } {1 {wrong # args: should be "encoding option ?arg ...?"}}

   113 test cmdAH-4.2 {Tcl_EncodingObjCmd} {

   114     list [catch {encoding foo} msg] $msg

   115 } {1 {bad option "foo": must be convertfrom, convertto, names, or system}}

   116 test cmdAH-4.3 {Tcl_EncodingObjCmd} {

   117     list [catch {encoding convertto} msg] $msg

   118 } {1 {wrong # args: should be "encoding convertto ?encoding? data"}}

   119 test cmdAH-4.4 {Tcl_EncodingObjCmd} {

   120     list [catch {encoding convertto foo bar} msg] $msg

   121 } {1 {unknown encoding "foo"}}

   122 test cmdAH-4.5 {Tcl_EncodingObjCmd} {

   123     set system [encoding system]

   124     encoding system jis0208

   125     set x [encoding convertto \u4e4e]

   126     encoding system $system

   127     set x

   128 } 8C

   129 test cmdAH-4.6 {Tcl_EncodingObjCmd} {

   130     set system [encoding system]

   131     encoding system identity

   132     set x [encoding convertto jis0208 \u4e4e]

   133     encoding system $system

   134     set x

   135 } 8C

   136 test cmdAH-4.7 {Tcl_EncodingObjCmd} {

   137     list [catch {encoding convertfrom} msg] $msg

   138 } {1 {wrong # args: should be "encoding convertfrom ?encoding? data"}}

   139 test cmdAH-4.8 {Tcl_EncodingObjCmd} {

   140     list [catch {encoding convertfrom foo bar} msg] $msg

   141 } {1 {unknown encoding "foo"}}

   142 test cmdAH-4.9 {Tcl_EncodingObjCmd} {

   143     set system [encoding system]

   144     encoding system jis0208

   145     set x [encoding convertfrom 8C]

   146     encoding system $system

   147     set x

   148 } \u4e4e

   149 test cmdAH-4.10 {Tcl_EncodingObjCmd} {

   150     set system [encoding system]

   151     encoding system identity

   152     set x [encoding convertfrom jis0208 8C]

   153     encoding system $system

   154     set x

   155 } \u4e4e

   156 test cmdAH-4.11 {Tcl_EncodingObjCmd} {

   157     list [catch {encoding names foo} msg] $msg

   158 } {1 {wrong # args: should be "encoding names"}}

   159 test cmdAH-4.12 {Tcl_EncodingObjCmd} {

   160     list [catch {encoding system foo bar} msg] $msg

   161 } {1 {wrong # args: should be "encoding system ?encoding?"}}

   162 test cmdAH-4.13 {Tcl_EncodingObjCmd} {

   163     set system [encoding system]

   164     encoding system identity

   165     set x [encoding system]

   166     encoding system $system

   167     set x

   168 } identity

   170 test cmdAH-5.1 {Tcl_FileObjCmd} {

   171     list [catch file msg] $msg

   172 } {1 {wrong # args: should be "file option ?arg ...?"}}

   173 test cmdAH-5.2 {Tcl_FileObjCmd} {

   174     list [catch {file x} msg] $msg

   175 } {1 {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}

   176 test cmdAH-5.3 {Tcl_FileObjCmd} {

   177     list [catch {file exists} msg] $msg

   178 } {1 {wrong # args: should be "file exists name"}}

   179 test cmdAH-5.4 {Tcl_FileObjCmd} {

   180     list [catch {file exists ""} msg] $msg

   181 } {0 0}

   183 #volume

   185 test cmdAH-6.1 {Tcl_FileObjCmd: volumes} {

   186     list [catch {file volumes x} msg] $msg

   187 } {1 {wrong # args: should be "file volumes"}}

   188 test cmdAH-6.2 {Tcl_FileObjCmd: volumes} {

   189 	set volumeList [file volumes]

   190 	if { [llength $volumeList] == 0 } {

   191 		set result 0

   192 	} else {

   193 		set result 1

   194 	}

   195 } {1}

   196 test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {macOrUnix} {

   197     set volumeList [file volumes]

   198     catch [list glob -nocomplain [lindex $volumeList 0]*]

   199 } {0}

   200 test cmdAH-6.4 {Tcl_FileObjCmd: volumes} winOnly {

   201     set volumeList [string tolower [file volumes]]

   202     list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}]

   203 } {0 1 0}

   205 test cmdAH-6.5 {cd} {unixOnly nonPortable} {

   206     set dir [pwd]

   207     cd /

   208     set res [pwd]

   209     cd $dir

   210     set res

   211 } {/}

   213 # attributes

   215 test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} {

   216     set foofile [makeFile abcde foo.file]

   217     catch {file delete -force $foofile}

   218     close [open $foofile w]

   219     set res [catch {file attributes $foofile}]

   220     # We used [makeFile] so we undo with [removeFile]

   221     removeFile $foofile

   222     set res

   223 } {0}

   225 # dirname

   227 if {[info commands testsetplatform] == {}} {

   228     puts "This application hasn't been compiled with the \"testsetplatform\""

   229     puts "command, so I can't test Tcl_FileObjCmd etc."

   230 } else {

   231 test cmdAH-8.1 {Tcl_FileObjCmd: dirname} {

   232     testsetplatform unix

   233     list [catch {file dirname a b} msg] $msg

   234 } {1 {wrong # args: should be "file dirname name"}}

   235 test cmdAH-8.2 {Tcl_FileObjCmd: dirname} {

   236     testsetplatform unix

   237     file dirname /a/b

   238 } /a

   239 test cmdAH-8.3 {Tcl_FileObjCmd: dirname} {

   240     testsetplatform unix

   241     file dirname {}

   242 } .

   243 test cmdAH-8.4 {Tcl_FileObjCmd: dirname} {

   244     testsetplatform mac

   245     file dirname {}

   246 } :

   247 test cmdAH-8.5 {Tcl_FileObjCmd: dirname} {

   248     testsetplatform win

   249     file dirname {}

   250 } .

   251 test cmdAH-8.6 {Tcl_FileObjCmd: dirname} {

   252     testsetplatform unix

   253     file dirname .def

   254 } .

   255 test cmdAH-8.7 {Tcl_FileObjCmd: dirname} {

   256     testsetplatform mac

   257     file dirname a

   258 } :

   259 test cmdAH-8.8 {Tcl_FileObjCmd: dirname} {

   260     testsetplatform win

   261     file dirname a

   262 } .

   263 test cmdAH-8.9 {Tcl_FileObjCmd: dirname} {

   264     testsetplatform unix

   265     file dirname a/b/c.d

   266 } a/b

   267 test cmdAH-8.10 {Tcl_FileObjCmd: dirname} {

   268     testsetplatform unix

   269     file dirname a/b.c/d

   270 } a/b.c

   271 test cmdAH-8.11 {Tcl_FileObjCmd: dirname} {

   272     testsetplatform unix

   273     file dirname /.

   274 } /

   275 test cmdAH-8.12 {Tcl_FileObjCmd: dirname} {

   276     testsetplatform unix

   277     list [catch {file dirname /} msg] $msg

   278 } {0 /}

   279 test cmdAH-8.13 {Tcl_FileObjCmd: dirname} {

   280     testsetplatform unix

   281     list [catch {file dirname /foo} msg] $msg

   282 } {0 /}

   283 test cmdAH-8.14 {Tcl_FileObjCmd: dirname} {

   284     testsetplatform unix

   285     list [catch {file dirname //foo} msg] $msg

   286 } {0 /}

   287 test cmdAH-8.15 {Tcl_FileObjCmd: dirname} {

   288     testsetplatform unix

   289     list [catch {file dirname //foo/bar} msg] $msg

   290 } {0 /foo}

   291 test cmdAH-8.16 {Tcl_FileObjCmd: dirname} {

   292     testsetplatform unix

   293     list [catch {file dirname {//foo\/bar/baz}} msg] $msg

   294 } {0 {/foo\/bar}}

   295 test cmdAH-8.17 {Tcl_FileObjCmd: dirname} {

   296     testsetplatform unix

   297     list [catch {file dirname {//foo\/bar/baz/blat}} msg] $msg

   298 } {0 {/foo\/bar/baz}}

   299 test cmdAH-8.18 {Tcl_FileObjCmd: dirname} {

   300     testsetplatform unix

   301     list [catch {file dirname /foo//} msg] $msg

   302 } {0 /}

   303 test cmdAH-8.19 {Tcl_FileObjCmd: dirname} {

   304     testsetplatform unix

   305     list [catch {file dirname ./a} msg] $msg

   306 } {0 .}

   307 test cmdAH-8.20 {Tcl_FileObjCmd: dirname} {

   308     testsetplatform unix

   309     list [catch {file dirname a/.a} msg] $msg

   310 } {0 a}

   311 test cmdAH-8.21 {Tcl_FileObjCmd: dirname} {

   312     testsetplatform windows

   313     list [catch {file dirname c:foo} msg] $msg

   314 } {0 c:}

   315 test cmdAH-8.22 {Tcl_FileObjCmd: dirname} {

   316     testsetplatform windows

   317     list [catch {file dirname c:} msg] $msg

   318 } {0 c:}

   319 test cmdAH-8.23 {Tcl_FileObjCmd: dirname} {

   320     testsetplatform windows

   321     list [catch {file dirname c:/} msg] $msg

   322 } {0 c:/}

   323 test cmdAH-8.24 {Tcl_FileObjCmd: dirname} {

   324     testsetplatform windows

   325     list [catch {file dirname {c:\foo}} msg] $msg

   326 } {0 c:/}

   327 test cmdAH-8.25 {Tcl_FileObjCmd: dirname} {

   328     testsetplatform windows

   329     list [catch {file dirname {//foo/bar/baz}} msg] $msg

   330 } {0 //foo/bar}

   331 test cmdAH-8.26 {Tcl_FileObjCmd: dirname} {

   332     testsetplatform windows

   333     list [catch {file dirname {//foo/bar}} msg] $msg

   334 } {0 //foo/bar}

   335 test cmdAH-8.27 {Tcl_FileObjCmd: dirname} {

   336     testsetplatform mac

   337     list [catch {file dirname :} msg] $msg

   338 } {0 :}

   339 test cmdAH-8.28 {Tcl_FileObjCmd: dirname} {

   340     testsetplatform mac

   341     list [catch {file dirname :Foo} msg] $msg

   342 } {0 :}

   343 test cmdAH-8.29 {Tcl_FileObjCmd: dirname} {

   344     testsetplatform mac

   345     list [catch {file dirname Foo:} msg] $msg

   346 } {0 Foo:}

   347 test cmdAH-8.30 {Tcl_FileObjCmd: dirname} {

   348     testsetplatform mac

   349     list [catch {file dirname Foo:bar} msg] $msg

   350 } {0 Foo:}

   351 test cmdAH-8.31 {Tcl_FileObjCmd: dirname} {

   352     testsetplatform mac

   353     list [catch {file dirname :Foo:bar} msg] $msg

   354 } {0 :Foo}

   355 test cmdAH-8.32 {Tcl_FileObjCmd: dirname} {

   356     testsetplatform mac

   357     list [catch {file dirname ::} msg] $msg

   358 } {0 :}

   359 test cmdAH-8.33 {Tcl_FileObjCmd: dirname} {

   360     testsetplatform mac

   361     list [catch {file dirname :::} msg] $msg

   362 } {0 ::}

   363 test cmdAH-8.34 {Tcl_FileObjCmd: dirname} {

   364     testsetplatform mac

   365     list [catch {file dirname /foo/bar/} msg] $msg

   366 } {0 foo:}

   367 test cmdAH-8.35 {Tcl_FileObjCmd: dirname} {

   368     testsetplatform mac

   369     list [catch {file dirname /foo/bar} msg] $msg

   370 } {0 foo:}

   371 test cmdAH-8.36 {Tcl_FileObjCmd: dirname} {

   372     testsetplatform mac

   373     list [catch {file dirname /foo} msg] $msg

   374 } {0 foo:}

   375 test cmdAH-8.37 {Tcl_FileObjCmd: dirname} {

   376     testsetplatform mac

   377     list [catch {file dirname foo} msg] $msg

   378 } {0 :}

   379 test cmdAH-8.38 {Tcl_FileObjCmd: dirname} {

   380     testsetplatform unix

   381     list [catch {file dirname ~/foo} msg] $msg

   382 } {0 ~}

   383 test cmdAH-8.39 {Tcl_FileObjCmd: dirname} {

   384     testsetplatform unix

   385     list [catch {file dirname ~bar/foo} msg] $msg

   386 } {0 ~bar}

   387 test cmdAH-8.40 {Tcl_FileObjCmd: dirname} {

   388     testsetplatform mac

   389     list [catch {file dirname ~bar/foo} msg] $msg

   390 } {0 ~bar:}

   391 test cmdAH-8.41 {Tcl_FileObjCmd: dirname} {

   392     testsetplatform mac

   393     list [catch {file dirname ~/foo} msg] $msg

   394 } {0 ~:}

   395 test cmdAH-8.42 {Tcl_FileObjCmd: dirname} {

   396     testsetplatform mac

   397     list [catch {file dirname ~:baz} msg] $msg

   398 } {0 ~:}

   399 test cmdAH-8.43 {Tcl_FileObjCmd: dirname} {

   400     global env

   401     set temp $env(HOME)

   402     set env(HOME) "/homewontexist/test"

   403     testsetplatform unix

   404     set result [list [catch {file dirname ~} msg] $msg]

   405     set env(HOME) $temp

   406     set result

   407 } {0 /homewontexist}

   408 test cmdAH-8.44 {Tcl_FileObjCmd: dirname} {

   409     global env

   410     set temp $env(HOME)

   411     set env(HOME) "~"

   412     testsetplatform unix

   413     set result [list [catch {file dirname ~} msg] $msg]

   414     set env(HOME) $temp

   415     set result

   416 } {0 ~}

   417 test cmdAH-8.45 {Tcl_FileObjCmd: dirname} {

   418     global env

   419     set temp $env(HOME)

   420     set env(HOME) "/homewontexist/test"

   421     testsetplatform windows

   422     set result [list [catch {file dirname ~} msg] $msg]

   423     set env(HOME) $temp

   424     set result

   425 } {0 /homewontexist}

   426 test cmdAH-8.46 {Tcl_FileObjCmd: dirname} {

   427     global env

   428     set temp $env(HOME)

   429     set env(HOME) "/home/test"

   430     testsetplatform mac

   431     set result [list [catch {file dirname ~} msg] $msg]

   432     set env(HOME) $temp

   433     set result

   434 } {0 home:}

   436 # tail

   438 test cmdAH-9.1 {Tcl_FileObjCmd: tail} {

   439     testsetplatform unix

   440     list [catch {file tail a b} msg] $msg

   441 } {1 {wrong # args: should be "file tail name"}}

   442 test cmdAH-9.2 {Tcl_FileObjCmd: tail} {

   443     testsetplatform unix

   444     file tail /a/b

   445 } b

   446 test cmdAH-9.3 {Tcl_FileObjCmd: tail} {

   447     testsetplatform unix

   448     file tail {}

   449 } {}

   450 test cmdAH-9.4 {Tcl_FileObjCmd: tail} {

   451     testsetplatform mac

   452     file tail {}

   453 } {}

   454 test cmdAH-9.5 {Tcl_FileObjCmd: tail} {

   455     testsetplatform win

   456     file tail {}

   457 } {}

   458 test cmdAH-9.6 {Tcl_FileObjCmd: tail} {

   459     testsetplatform unix

   460     file tail .def

   461 } .def

   462 test cmdAH-9.7 {Tcl_FileObjCmd: tail} {

   463     testsetplatform mac

   464     file tail a

   465 } a

   466 test cmdAH-9.8 {Tcl_FileObjCmd: tail} {

   467     testsetplatform win

   468     file tail a

   469 } a

   470 test cmdAH-9.9 {Tcl_FileObjCmd: tail} {

   471     testsetplatform unix

   472     file ta a/b/c.d

   473 } c.d

   474 test cmdAH-9.10 {Tcl_FileObjCmd: tail} {

   475     testsetplatform unix

   476     file tail a/b.c/d

   477 } d

   478 test cmdAH-9.11 {Tcl_FileObjCmd: tail} {

   479     testsetplatform unix

   480     file tail /.

   481 } .

   482 test cmdAH-9.12 {Tcl_FileObjCmd: tail} {

   483     testsetplatform unix

   484     file tail /

   485 } {}

   486 test cmdAH-9.13 {Tcl_FileObjCmd: tail} {

   487     testsetplatform unix

   488     file tail /foo

   489 } foo

   490 test cmdAH-9.14 {Tcl_FileObjCmd: tail} {

   491     testsetplatform unix

   492     file tail //foo

   493 } foo

   494 test cmdAH-9.15 {Tcl_FileObjCmd: tail} {

   495     testsetplatform unix

   496     file tail //foo/bar

   497 } bar

   498 test cmdAH-9.16 {Tcl_FileObjCmd: tail} {

   499     testsetplatform unix

   500     file tail {//foo\/bar/baz}

   501 } baz

   502 test cmdAH-9.17 {Tcl_FileObjCmd: tail} {

   503     testsetplatform unix

   504     file tail {//foo\/bar/baz/blat}

   505 } blat

   506 test cmdAH-9.18 {Tcl_FileObjCmd: tail} {

   507     testsetplatform unix

   508     file tail /foo//

   509 } foo

   510 test cmdAH-9.19 {Tcl_FileObjCmd: tail} {

   511     testsetplatform unix

   512     file tail ./a

   513 } a

   514 test cmdAH-9.20 {Tcl_FileObjCmd: tail} {

   515     testsetplatform unix

   516     file tail a/.a

   517 } .a

   518 test cmdAH-9.21 {Tcl_FileObjCmd: tail} {

   519     testsetplatform windows

   520     file tail c:foo

   521 } foo

   522 test cmdAH-9.22 {Tcl_FileObjCmd: tail} {

   523     testsetplatform windows

   524     file tail c:

   525 } {}

   526 test cmdAH-9.23 {Tcl_FileObjCmd: tail} {

   527     testsetplatform windows

   528     file tail c:/

   529 } {}

   530 test cmdAH-9.24 {Tcl_FileObjCmd: tail} {

   531     testsetplatform windows

   532     file tail {c:\foo}

   533 } foo

   534 test cmdAH-9.25 {Tcl_FileObjCmd: tail} {

   535     testsetplatform windows

   536     file tail {//foo/bar/baz}

   537 } baz

   538 test cmdAH-9.26 {Tcl_FileObjCmd: tail} {

   539     testsetplatform windows

   540     file tail {//foo/bar}

   541 } {}

   542 test cmdAH-9.27 {Tcl_FileObjCmd: tail} {

   543     testsetplatform mac

   544     file tail :

   545 } :

   546 test cmdAH-9.28 {Tcl_FileObjCmd: tail} {

   547     testsetplatform mac

   548     file tail :Foo

   549 } Foo

   550 test cmdAH-9.29 {Tcl_FileObjCmd: tail} {

   551     testsetplatform mac

   552     file tail Foo:

   553 } {}

   554 test cmdAH-9.30 {Tcl_FileObjCmd: tail} {

   555     testsetplatform mac

   556     file tail Foo:bar

   557 } bar

   558 test cmdAH-9.31 {Tcl_FileObjCmd: tail} {

   559     testsetplatform mac

   560     file tail :Foo:bar

   561 } bar

   562 test cmdAH-9.32 {Tcl_FileObjCmd: tail} {

   563     testsetplatform mac

   564     file tail ::

   565 } ::

   566 test cmdAH-9.33 {Tcl_FileObjCmd: tail} {

   567     testsetplatform mac

   568     file tail :::

   569 } ::

   570 test cmdAH-9.34 {Tcl_FileObjCmd: tail} {

   571     testsetplatform mac

   572     file tail /foo/bar/

   573 } bar

   574 test cmdAH-9.35 {Tcl_FileObjCmd: tail} {

   575     testsetplatform mac

   576     file tail /foo/bar

   577 } bar

   578 test cmdAH-9.36 {Tcl_FileObjCmd: tail} {

   579     testsetplatform mac

   580     file tail /foo

   581 } {}

   582 test cmdAH-9.37 {Tcl_FileObjCmd: tail} {

   583     testsetplatform mac

   584     file tail foo

   585 } foo

   586 test cmdAH-9.38 {Tcl_FileObjCmd: tail} {

   587     testsetplatform mac

   588     file tail ~:foo

   589 } foo

   590 test cmdAH-9.39 {Tcl_FileObjCmd: tail} {

   591     testsetplatform mac

   592     file tail ~bar:foo

   593 } foo

   594 test cmdAH-9.40 {Tcl_FileObjCmd: tail} {

   595     testsetplatform mac

   596     file tail ~bar/foo

   597 } foo

   598 test cmdAH-9.41 {Tcl_FileObjCmd: tail} {

   599     testsetplatform mac

   600     file tail ~/foo

   601 } foo

   602 test cmdAH-9.42 {Tcl_FileObjCmd: tail} {

   603     global env

   604     set temp $env(HOME)

   605     set env(HOME) "/home/test"

   606     testsetplatform unix

   607     set result [file tail ~]

   608     set env(HOME) $temp

   609     set result

   610 } test

   611 test cmdAH-9.43 {Tcl_FileObjCmd: tail} {

   612     global env

   613     set temp $env(HOME)

   614     set env(HOME) "~"

   615     testsetplatform unix

   616     set result [file tail ~]

   617     set env(HOME) $temp

   618     set result

   619 } {}

   620 test cmdAH-9.44 {Tcl_FileObjCmd: tail} {

   621     global env

   622     set temp $env(HOME)

   623     set env(HOME) "/home/test"

   624     testsetplatform windows

   625     set result [file tail ~]

   626     set env(HOME) $temp

   627     set result

   628 } test

   629 test cmdAH-9.45 {Tcl_FileObjCmd: tail} {

   630     global env

   631     set temp $env(HOME)

   632     set env(HOME) "/home/test"

   633     testsetplatform mac

   634     set result [file tail ~]

   635     set env(HOME) $temp

   636     set result

   637 } test

   638 test cmdAH-9.46 {Tcl_FileObjCmd: tail} {

   639     testsetplatform unix

   640     file tail {f.oo\bar/baz.bat}

   641 } baz.bat

   642 test cmdAH-9.47 {Tcl_FileObjCmd: tail} {

   643     testsetplatform windows

   644     file tail c:foo

   645 } foo

   646 test cmdAH-9.48 {Tcl_FileObjCmd: tail} {

   647     testsetplatform windows

   648     file tail c:

   649 } {}

   650 test cmdAH-9.49 {Tcl_FileObjCmd: tail} {

   651     testsetplatform windows

   652     file tail c:/foo

   653 } foo

   654 test cmdAH-9.50 {Tcl_FileObjCmd: tail} {

   655     testsetplatform windows

   656     file tail {c:/foo\bar}

   657 } bar

   658 test cmdAH-9.51 {Tcl_FileObjCmd: tail} {

   659     testsetplatform windows

   660     file tail {foo\bar}

   661 } bar

   663 # rootname

   665 test cmdAH-10.1 {Tcl_FileObjCmd: rootname} {

   666     testsetplatform unix

   667     list [catch {file rootname a b} msg] $msg

   668 } {1 {wrong # args: should be "file rootname name"}}

   669 test cmdAH-10.2 {Tcl_FileObjCmd: rootname} {

   670     testsetplatform unix

   671     file rootname {}

   672 } {}

   673 test cmdAH-10.3 {Tcl_FileObjCmd: rootname} {

   674     testsetplatform unix

   675     file ro foo

   676 } foo

   677 test cmdAH-10.4 {Tcl_FileObjCmd: rootname} {

   678     testsetplatform unix

   679     file rootname foo.

   680 } foo

   681 test cmdAH-10.5 {Tcl_FileObjCmd: rootname} {

   682     testsetplatform unix

   683     file rootname .foo

   684 } {}

   685 test cmdAH-10.6 {Tcl_FileObjCmd: rootname} {

   686     testsetplatform unix

   687     file rootname abc.def

   688 } abc

   689 test cmdAH-10.7 {Tcl_FileObjCmd: rootname} {

   690     testsetplatform unix

   691     file rootname abc.def.ghi

   692 } abc.def

   693 test cmdAH-10.8 {Tcl_FileObjCmd: rootname} {

   694     testsetplatform unix

   695     file rootname a/b/c.d

   696 } a/b/c

   697 test cmdAH-10.9 {Tcl_FileObjCmd: rootname} {

   698     testsetplatform unix

   699     file rootname a/b.c/d

   700 } a/b.c/d

   701 test cmdAH-10.10 {Tcl_FileObjCmd: rootname} {

   702     testsetplatform unix

   703     file rootname a/b.c/

   704 } a/b.c/

   705 test cmdAH-10.11 {Tcl_FileObjCmd: rootname} {

   706     testsetplatform mac

   707     file ro foo

   708 } foo

   709 test cmdAH-10.12 {Tcl_FileObjCmd: rootname} {

   710     testsetplatform mac

   711     file rootname {}

   712 } {}

   713 test cmdAH-10.13 {Tcl_FileObjCmd: rootname} {

   714     testsetplatform mac

   715     file rootname foo.

   716 } foo

   717 test cmdAH-10.14 {Tcl_FileObjCmd: rootname} {

   718     testsetplatform mac

   719     file rootname .foo

   720 } {}

   721 test cmdAH-10.15 {Tcl_FileObjCmd: rootname} {

   722     testsetplatform mac

   723     file rootname abc.def

   724 } abc

   725 test cmdAH-10.16 {Tcl_FileObjCmd: rootname} {

   726     testsetplatform mac

   727     file rootname abc.def.ghi

   728 } abc.def

   729 test cmdAH-10.17 {Tcl_FileObjCmd: rootname} {

   730     testsetplatform mac

   731     file rootname a:b:c.d

   732 } a:b:c

   733 test cmdAH-10.18 {Tcl_FileObjCmd: rootname} {

   734     testsetplatform mac

   735     file rootname a:b.c:d

   736 } a:b.c:d

   737 test cmdAH-10.19 {Tcl_FileObjCmd: rootname} {

   738     testsetplatform mac

   739     file rootname a/b/c.d

   740 } a/b/c

   741 test cmdAH-10.20 {Tcl_FileObjCmd: rootname} {

   742     testsetplatform mac

   743     file rootname a/b.c/d

   744 } a/b.c/d

   745 test cmdAH-10.21 {Tcl_FileObjCmd: rootname} {

   746     testsetplatform mac

   747     file rootname /a.b

   748 } /a

   749 test cmdAH-10.22 {Tcl_FileObjCmd: rootname} {

   750     testsetplatform mac

   751     file rootname foo.c:

   752 } foo.c:

   753 test cmdAH-10.23 {Tcl_FileObjCmd: rootname} {

   754     testsetplatform windows

   755     file rootname {}

   756 } {}

   757 test cmdAH-10.24 {Tcl_FileObjCmd: rootname} {

   758     testsetplatform windows

   759     file ro foo

   760 } foo

   761 test cmdAH-10.25 {Tcl_FileObjCmd: rootname} {

   762     testsetplatform windows

   763     file rootname foo.

   764 } foo

   765 test cmdAH-10.26 {Tcl_FileObjCmd: rootname} {

   766     testsetplatform windows

   767     file rootname .foo

   768 } {}

   769 test cmdAH-10.27 {Tcl_FileObjCmd: rootname} {

   770     testsetplatform windows

   771     file rootname abc.def

   772 } abc

   773 test cmdAH-10.28 {Tcl_FileObjCmd: rootname} {

   774     testsetplatform windows

   775     file rootname abc.def.ghi

   776 } abc.def

   777 test cmdAH-10.29 {Tcl_FileObjCmd: rootname} {

   778     testsetplatform windows

   779     file rootname a/b/c.d

   780 } a/b/c

   781 test cmdAH-10.30 {Tcl_FileObjCmd: rootname} {

   782     testsetplatform windows

   783     file rootname a/b.c/d

   784 } a/b.c/d

   785 test cmdAH-10.31 {Tcl_FileObjCmd: rootname} {

   786     testsetplatform windows

   787     file rootname a\\b.c\\

   788 } a\\b.c\\

   789 test cmdAH-10.32 {Tcl_FileObjCmd: rootname} {

   790     testsetplatform windows

   791     file rootname a\\b\\c.d

   792 } a\\b\\c

   793 test cmdAH-10.33 {Tcl_FileObjCmd: rootname} {

   794     testsetplatform windows

   795     file rootname a\\b.c\\d

   796 } a\\b.c\\d

   797 test cmdAH-10.34 {Tcl_FileObjCmd: rootname} {

   798     testsetplatform windows

   799     file rootname a\\b.c\\

   800 } a\\b.c\\

   801 set num 35

   802 foreach outer { {} a .a a. a.a } {

   803   foreach inner { {} a .a a. a.a } {

   804     set thing [format %s/%s $outer $inner]

   805 ;   test cmdAH-6.$num {Tcl_FileObjCmd: rootname and extension options} {

   806 	testsetplatform unix

   807 	format %s%s [file rootname $thing] [file ext $thing]

   808     } $thing

   809     set num [expr $num+1]

   810   }

   811 }

   813 # extension

   815 test cmdAH-11.1 {Tcl_FileObjCmd: extension} {

   816     testsetplatform unix

   817     list [catch {file extension a b} msg] $msg

   818 } {1 {wrong # args: should be "file extension name"}}

   819 test cmdAH-11.2 {Tcl_FileObjCmd: extension} {

   820     testsetplatform unix

   821     file extension {}

   822 } {}

   823 test cmdAH-11.3 {Tcl_FileObjCmd: extension} {

   824     testsetplatform unix

   825     file ext foo

   826 } {}

   827 test cmdAH-11.4 {Tcl_FileObjCmd: extension} {

   828     testsetplatform unix

   829     file extension foo.

   830 } .

   831 test cmdAH-11.5 {Tcl_FileObjCmd: extension} {

   832     testsetplatform unix

   833     file extension .foo

   834 } .foo

   835 test cmdAH-11.6 {Tcl_FileObjCmd: extension} {

   836     testsetplatform unix

   837     file extension abc.def

   838 } .def

   839 test cmdAH-11.7 {Tcl_FileObjCmd: extension} {

   840     testsetplatform unix

   841     file extension abc.def.ghi

   842 } .ghi

   843 test cmdAH-11.8 {Tcl_FileObjCmd: extension} {

   844     testsetplatform unix

   845     file extension a/b/c.d

   846 } .d

   847 test cmdAH-11.9 {Tcl_FileObjCmd: extension} {

   848     testsetplatform unix

   849     file extension a/b.c/d

   850 } {}

   851 test cmdAH-11.10 {Tcl_FileObjCmd: extension} {

   852     testsetplatform unix

   853     file extension a/b.c/

   854 } {}

   855 test cmdAH-11.11 {Tcl_FileObjCmd: extension} {

   856     testsetplatform mac

   857     file ext foo

   858 } {}

   859 test cmdAH-11.12 {Tcl_FileObjCmd: extension} {

   860     testsetplatform mac

   861     file extension {}

   862 } {}

   863 test cmdAH-11.13 {Tcl_FileObjCmd: extension} {

   864     testsetplatform mac

   865     file extension foo.

   866 } .

   867 test cmdAH-11.14 {Tcl_FileObjCmd: extension} {

   868     testsetplatform mac

   869     file extension .foo

   870 } .foo

   871 test cmdAH-11.15 {Tcl_FileObjCmd: extension} {

   872     testsetplatform mac

   873     file extension abc.def

   874 } .def

   875 test cmdAH-11.16 {Tcl_FileObjCmd: extension} {

   876     testsetplatform mac

   877     file extension abc.def.ghi

   878 } .ghi

   879 test cmdAH-11.17 {Tcl_FileObjCmd: extension} {

   880     testsetplatform mac

   881     file extension a:b:c.d

   882 } .d

   883 test cmdAH-11.18 {Tcl_FileObjCmd: extension} {

   884     testsetplatform mac

   885     file extension a:b.c:d

   886 } {}

   887 test cmdAH-11.19 {Tcl_FileObjCmd: extension} {

   888     testsetplatform mac

   889     file extension a/b/c.d

   890 } .d

   891 test cmdAH-11.20 {Tcl_FileObjCmd: extension} {

   892     testsetplatform mac

   893     file extension a/b.c/d

   894 } {}

   895 test cmdAH-11.21 {Tcl_FileObjCmd: extension} {

   896     testsetplatform mac

   897     file extension /a.b

   898 } .b

   899 test cmdAH-11.22 {Tcl_FileObjCmd: extension} {

   900     testsetplatform mac

   901     file extension foo.c:

   902 } {}

   903 test cmdAH-11.23 {Tcl_FileObjCmd: extension} {

   904     testsetplatform windows

   905     file extension {}

   906 } {}

   907 test cmdAH-11.24 {Tcl_FileObjCmd: extension} {

   908     testsetplatform windows

   909     file ext foo

   910 } {}

   911 test cmdAH-11.25 {Tcl_FileObjCmd: extension} {

   912     testsetplatform windows

   913     file extension foo.

   914 } .

   915 test cmdAH-11.26 {Tcl_FileObjCmd: extension} {

   916     testsetplatform windows

   917     file extension .foo

   918 } .foo

   919 test cmdAH-11.27 {Tcl_FileObjCmd: extension} {

   920     testsetplatform windows

   921     file extension abc.def

   922 } .def

   923 test cmdAH-11.28 {Tcl_FileObjCmd: extension} {

   924     testsetplatform windows

   925     file extension abc.def.ghi

   926 } .ghi

   927 test cmdAH-11.29 {Tcl_FileObjCmd: extension} {

   928     testsetplatform windows

   929     file extension a/b/c.d

   930 } .d

   931 test cmdAH-11.30 {Tcl_FileObjCmd: extension} {

   932     testsetplatform windows

   933     file extension a/b.c/d

   934 } {}

   935 test cmdAH-11.31 {Tcl_FileObjCmd: extension} {

   936     testsetplatform windows

   937     file extension a\\b.c\\

   938 } {}

   939 test cmdAH-11.32 {Tcl_FileObjCmd: extension} {

   940     testsetplatform windows

   941     file extension a\\b\\c.d

   942 } .d

   943 test cmdAH-11.33 {Tcl_FileObjCmd: extension} {

   944     testsetplatform windows

   945     file extension a\\b.c\\d

   946 } {}

   947 test cmdAH-11.34 {Tcl_FileObjCmd: extension} {

   948     testsetplatform windows

   949     file extension a\\b.c\\

   950 } {}

   951 set num 35

   952 foreach value {a..b a...b a.c..b ..b} result {.b .b .b .b} {

   953     foreach p {unix mac windows} {

   954 ;	test cmdAH-7.$num {Tcl_FileObjCmd: extension} "

   955 	    testsetplatform $p

   956 	    file extension $value

   957 	" $result

   958 	incr num

   959     }

   960 }

   962 # pathtype

   964 test cmdAH-12.1 {Tcl_FileObjCmd: pathtype} {

   965     testsetplatform unix

   966     list [catch {file pathtype a b} msg] $msg

   967 } {1 {wrong # args: should be "file pathtype name"}}

   968 test cmdAH-12.2 {Tcl_FileObjCmd: pathtype} {

   969     testsetplatform unix

   970     file pathtype /a

   971 } absolute

   972 test cmdAH-12.3 {Tcl_FileObjCmd: pathtype} {

   973     testsetplatform unix

   974     file p a

   975 } relative

   976 test cmdAH-12.4 {Tcl_FileObjCmd: pathtype} {

   977     testsetplatform windows

   978     file pathtype c:a

   979 } volumerelative

   981 # split

   983 test cmdAH-13.1 {Tcl_FileObjCmd: split} {

   984     testsetplatform unix

   985     list [catch {file split a b} msg] $msg

   986 } {1 {wrong # args: should be "file split name"}}

   987 test cmdAH-13.2 {Tcl_FileObjCmd: split} {

   988     testsetplatform unix

   989     file split a

   990 } a

   991 test cmdAH-13.3 {Tcl_FileObjCmd: split} {

   992     testsetplatform unix

   993     file split a/b

   994 } {a b}

   996 # join

   998 test cmdAH-14.1 {Tcl_FileObjCmd: join} {

   999     testsetplatform unix

  1000     file join a

  1001 } a

  1002 test cmdAH-14.2 {Tcl_FileObjCmd: join} {

  1003     testsetplatform unix

  1004     file join a b

  1005 } a/b

  1006 test cmdAH-14.3 {Tcl_FileObjCmd: join} {

  1007     testsetplatform unix

  1008     file join a b c d

  1009 } a/b/c/d

  1011 # error handling of Tcl_TranslateFileName

  1013 test cmdAH-15.1 {Tcl_FileObjCmd} {

  1014     testsetplatform unix

  1015     list [catch {file atime ~_bad_user} msg] $msg

  1016 } {1 {user "_bad_user" doesn't exist}}

  1018 testsetplatform $platform

  1019 }

  1021 # readable

  1023 set gorpfile [makeFile abcde gorp.file]

  1024 set dirfile [makeDirectory dir.file]

  1026 if {[info commands testchmod] == {}} {

  1027     puts "This application hasn't been compiled with the \"testchmod\""

  1028     puts "command, so I can't test Tcl_FileObjCmd etc."

  1029 } else {

  1030 test cmdAH-16.1 {Tcl_FileObjCmd: readable} {testchmod} {

  1031     list [catch {file readable a b} msg] $msg

  1032 } {1 {wrong # args: should be "file readable name"}}

  1033 testchmod 0444 $gorpfile

  1034 test cmdAH-16.2 {Tcl_FileObjCmd: readable} {testchmod} {

  1035     file readable $gorpfile

  1036 } 1

  1037 testchmod 0333 $gorpfile

  1038 test cmdAH-16.3 {Tcl_FileObjCmd: readable} {unixOnly notRoot testchmod} {

  1039     file reada $gorpfile

  1040 } 0

  1042 # writable

  1044 test cmdAH-17.1 {Tcl_FileObjCmd: writable} {testchmod} {

  1045     list [catch {file writable a b} msg] $msg

  1046 } {1 {wrong # args: should be "file writable name"}}

  1047 testchmod 0555 $gorpfile

  1048 test cmdAH-17.2 {Tcl_FileObjCmd: writable} {notRoot testchmod} {

  1049     file writable $gorpfile

  1050 } 0

  1051 testchmod 0222 $gorpfile

  1052 test cmdAH-17.3 {Tcl_FileObjCmd: writable} {testchmod} {

  1053     file writable $gorpfile

  1054 } 1

  1055 }

  1057 # executable

  1059 removeFile $gorpfile

  1060 removeDirectory $dirfile

  1061 set dirfile [makeDirectory dir.file]

  1062 set gorpfile [makeFile abcde gorp.file]

  1064 test cmdAH-18.1 {Tcl_FileObjCmd: executable} {testchmod} {

  1065     list [catch {file executable a b} msg] $msg

  1066 } {1 {wrong # args: should be "file executable name"}}

  1067 test cmdAH-18.2 {Tcl_FileObjCmd: executable} {testchmod notRoot} {

  1068     file executable $gorpfile

  1069 } 0

  1070 test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly testchmod} {

  1071     # Only on unix will setting the execute bit on a regular file

  1072     # cause that file to be executable.

  1074     testchmod 0775 $gorpfile

  1075     file exe $gorpfile

  1076 } 1

  1078 test cmdAH-18.4 {Tcl_FileObjCmd: executable} {macOnly testchmod} {

  1079     # On mac, the only executable files are of type APPL.

  1081     set x [file exe $gorpfile]

  1082     file attrib $gorpfile -type APPL

  1083     lappend x [file exe $gorpfile]

  1084 } {0 1}

  1085 test cmdAH-18.5 {Tcl_FileObjCmd: executable} {winOnly testchmod} {

  1086     # On pc, must be a .exe, .com, etc.

  1088     set x [file exe $gorpfile]

  1089     set gorpexe [makeFile foo gorp.exe]

  1090     lappend x [file exe $gorpexe]

  1091     removeFile $gorpexe

  1092     set x

  1093 } {0 1}

  1094 test cmdAH-18.6 {Tcl_FileObjCmd: executable} {testchmod} {

  1095     # Directories are always executable.

  1097     file exe $dirfile

  1098 } 1

  1100 removeDirectory $dirfile

  1101 removeFile $gorpfile

  1102 set linkfile [file join [temporaryDirectory] link.file]

  1103 file delete $linkfile

  1105 # exists

  1107 test cmdAH-19.1 {Tcl_FileObjCmd: exists} {

  1108     list [catch {file exists a b} msg] $msg

  1109 } {1 {wrong # args: should be "file exists name"}}

  1110 test cmdAH-19.2 {Tcl_FileObjCmd: exists} {file exists $gorpfile} 0

  1111 test cmdAH-19.3 {Tcl_FileObjCmd: exists} {

  1112     file exists [file join [temporaryDirectory] dir.file gorp.file]

  1113 } 0

  1114 catch {

  1115     set gorpfile [makeFile abcde gorp.file]

  1116     set dirfile [makeDirectory dir.file]

  1117     set subgorp [makeFile 12345 [file join $dirfile gorp.file]]

  1118 }

  1119 test cmdAH-19.4 {Tcl_FileObjCmd: exists} {

  1120     file exists $gorpfile

  1121 } 1

  1122 test cmdAH-19.5 {Tcl_FileObjCmd: exists} {

  1123     file exists $subgorp

  1124 } 1

  1126 # nativename

  1127 if {[info commands testsetplatform] == {}} {

  1128     puts "This application hasn't been compiled with the \"testsetplatform\""

  1129     puts "command, so I can't test Tcl_FileObjCmd etc."

  1130 } else {

  1131 test cmdAH-19.6 {Tcl_FileObjCmd: nativename} {

  1132     testsetplatform unix

  1133     list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]

  1134 } {0 a/b {}}

  1135 test cmdAH-19.7 {Tcl_FileObjCmd: nativename} {

  1136     testsetplatform windows

  1137     list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]

  1138 } {0 {a\b} {}}

  1139 test cmdAH-19.8 {Tcl_FileObjCmd: nativename} {

  1140     testsetplatform mac

  1141     list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]

  1142 } {0 :a:b {}}

  1143 }

  1145 test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} {

  1146     file exists ~nOsUcHuSeR

  1147 } 0

  1148 test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} {

  1149     # should probably be 0 in fact...

  1150     catch {file nativename ~nOsUcHuSeR}

  1151 } 1

  1153 # The test below has to be done in /tmp rather than the current

  1154 # directory in order to guarantee (?) a local file system:  some

  1155 # NFS file systems won't do the stuff below correctly.

  1157 test cmdAH-19.11 {Tcl_FileObjCmd: exists} {unixOnly notRoot} {

  1158     file delete -force /tmp/tcl.foo.dir/file

  1159     file delete -force /tmp/tcl.foo.dir

  1160     makeDirectory /tmp/tcl.foo.dir

  1161     makeFile 12345 /tmp/tcl.foo.dir/file

  1162     file attributes /tmp/tcl.foo.dir -permissions 0000

  1164     set result [file exists /tmp/tcl.foo.dir/file]

  1166     file attributes /tmp/tcl.foo.dir -permissions 0775

  1167     removeFile /tmp/tcl.foo.dir/file

  1168     removeDirectory /tmp/tcl.foo.dir

  1169     set result

  1170 } 0

  1172 # Stat related commands

  1174 catch {testsetplatform $platform}

  1175 removeFile $gorpfile

  1176 set gorpfile [makeFile "Test string" gorp.file]

  1177 catch {file attributes $gorpfile -permissions 0765}

  1179 # atime

  1181 set file [makeFile "data" touch.me]

  1183 test cmdAH-20.1 {Tcl_FileObjCmd: atime} {

  1184     list [catch {file atime a b c} msg] $msg

  1185 } {1 {wrong # args: should be "file atime name ?time?"}}

  1186 test cmdAH-20.2 {Tcl_FileObjCmd: atime} {

  1187     catch {unset stat}

  1188     file stat $gorpfile stat

  1189     list [expr {[file mtime $gorpfile] == $stat(mtime)}] \

  1190 	    [expr {[file atime $gorpfile] == $stat(atime)}]

  1191 } {1 1}

  1192 test cmdAH-20.3 {Tcl_FileObjCmd: atime} {

  1193     string tolower [list [catch {file atime _bogus_} msg] \

  1194 	    $msg $errorCode]

  1195 } {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}

  1196 test cmdAH-20.4 {Tcl_FileObjCmd: atime} {

  1197     list [catch {file atime $file notint} msg] $msg

  1198 } {1 {expected integer but got "notint"}}

  1199 test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {unixOrPc} {

  1200     if {[string equal $tcl_platform(platform) "windows"]} {

  1201 	set old [pwd]

  1202 	cd $::tcltest::temporaryDirectory

  1203 	if {![string equal "NTFS" [testvolumetype]]} {

  1204 	    # Windows FAT doesn't understand atime, but NTFS does

  1205 	    # May also fail for Windows on NFS mounted disks

  1206 	    cd $old

  1207 	    return 1

  1208 	}

  1209 	cd $old

  1210     }

  1211     set atime [file atime $file]

  1212     after 1100; # pause a sec to notice change in atime

  1213     set newatime [clock seconds]

  1214     set modatime [file atime $file $newatime]

  1215     expr {$newatime == $modatime ? 1 : "$newatime != $modatime"}

  1216 } 1

  1218 removeFile touch.me

  1219 # isdirectory

  1221 test cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} {

  1222     list [catch {file isdirectory a b} msg] $msg

  1223 } {1 {wrong # args: should be "file isdirectory name"}}

  1224 test cmdAH-21.2 {Tcl_FileObjCmd: isdirectory} {

  1225     file isdirectory $gorpfile

  1226 } 0

  1227 test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {

  1228     file isd $dirfile

  1229 } 1

  1231 # isfile

  1233 test cmdAH-22.1 {Tcl_FileObjCmd: isfile} {

  1234     list [catch {file isfile a b} msg] $msg

  1235 } {1 {wrong # args: should be "file isfile name"}}

  1236 test cmdAH-22.2 {Tcl_FileObjCmd: isfile} {file isfile $gorpfile} 1

  1237 test cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile $dirfile} 0

  1239 # lstat and readlink:  don't run these tests everywhere, since not all

  1240 # sites will have symbolic links

  1242 catch {file link -symbolic $linkfile $gorpfile}

  1243 test cmdAH-23.1 {Tcl_FileObjCmd: lstat} {

  1244     list [catch {file lstat a} msg] $msg

  1245 } {1 {wrong # args: should be "file lstat name varName"}}

  1246 test cmdAH-23.2 {Tcl_FileObjCmd: lstat} {

  1247     list [catch {file lstat a b c} msg] $msg

  1248 } {1 {wrong # args: should be "file lstat name varName"}}

  1249 test cmdAH-23.3 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {

  1250     catch {unset stat}

  1251     file lstat $linkfile stat

  1252     lsort [array names stat]

  1253 } {atime ctime dev gid ino mode mtime nlink size type uid}

  1254 test cmdAH-23.4 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {

  1255     catch {unset stat}

  1256     file lstat $linkfile stat

  1257     list $stat(nlink) [expr $stat(mode)&0777] $stat(type)

  1258 } {1 511 link}

  1259 test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {

  1260     string tolower [list [catch {file lstat _bogus_ stat} msg] \

  1261 	    $msg $errorCode]

  1262 } {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}

  1263 test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} {

  1264     catch {unset x}

  1265     set x 44

  1266     list [catch {file lstat $gorpfile x} msg] $msg $errorCode

  1267 } {1 {can't set "x(dev)": variable isn't array} NONE}

  1268 catch {unset stat}

  1270 # mkdir

  1272 set dirA [file join [temporaryDirectory] a]

  1273 set dirB [file join [temporaryDirectory] a]

  1274 test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} {

  1275     catch {file delete -force $dirA}

  1276     file mkdir $dirA

  1277     set res [file isdirectory $dirA]

  1278     file delete $dirA

  1279     set res

  1280 } {1}

  1281 test cmdAH-23.8 {Tcl_FileObjCmd: mkdir} {

  1282     catch {file delete -force $dirA}

  1283     file mkdir $dirA/b

  1284     set res [file isdirectory $dirA/b]

  1285     file delete -force $dirA

  1286     set res

  1287 } {1}

  1288 test cmdAH-23.9 {Tcl_FileObjCmd: mkdir} {

  1289     catch {file delete -force $dirA}

  1290     file mkdir $dirA/b/c

  1291     set res [file isdirectory $dirA/b/c]

  1292     file delete -force $dirA

  1293     set res

  1294 } {1}

  1295 test cmdAH-23.10 {Tcl_FileObjCmd: mkdir} {

  1296     catch {file delete -force $dirA}

  1297     catch {file delete -force $dirB}

  1298     file mkdir $dirA/b $dirB/a/c

  1299     set res [list [file isdirectory $dirA/b] [file isdirectory $dirB/a/c]]

  1300     file delete -force $dirA

  1301     file delete -force $dirB

  1302     set res

  1303 } {1 1}

  1305 # mtime

  1307 proc waitForEvenSecondForFAT {} {

  1308     # Windows 9x uses filesystems (the FAT* family of FSes) without

  1309     # enough data in its timestamps for even per-second-accurate

  1310     # timings.  :^(

  1311     # This procedure based on work by Helmut Giese

  1313     global tcl_platform

  1314     if {$tcl_platform(platform) ne "windows"} {return}

  1315     if {[lindex [file system [temporaryDirectory]] 1] == "NTFS"} {return}

  1316     # Assume non-NTFS means FAT{12,16,32} and hence in need of special help

  1317     set start [clock seconds]

  1318     while {1} {

  1319 	set now [clock seconds]

  1320 	if {$now!=$start && !($now & 1)} {

  1321 	    return

  1322 	}

  1323 	after 50

  1324     }

  1325 }

  1326 set file [makeFile "data" touch.me]

  1328 test cmdAH-24.1 {Tcl_FileObjCmd: mtime} {

  1329     list [catch {file mtime a b c} msg] $msg

  1330 } {1 {wrong # args: should be "file mtime name ?time?"}}

  1331 # Check (allowing for clock-skew and OS interrupts as best we can)

  1332 # that the change in mtime on a file being written is the time elapsed

  1333 # between writes.  Note that this can still fail on very busy systems

  1334 # if there are long preemptions between the writes and the reading of

  1335 # the clock, but there's not much you can do about that other than the

  1336 # completely horrible "keep on trying to write until you managed to do

  1337 # it all in less than a second."  - DKF

  1338 test cmdAH-24.2 {Tcl_FileObjCmd: mtime} {

  1339     waitForEvenSecondForFAT

  1340     set f [open $gorpfile w]

  1341     puts $f "More text"

  1342     close $f

  1343     set clockOld [clock seconds]

  1344     set fileOld [file mtime $gorpfile]

  1345     after 2000

  1346     set f [open $gorpfile w]

  1347     puts $f "More text"

  1348     close $f

  1349     set clockNew [clock seconds]

  1350     set fileNew [file mtime $gorpfile]

  1351     expr {

  1352 	(($fileNew > $fileOld) && ($clockNew > $clockOld) &&

  1353 	(abs(($fileNew-$fileOld) - ($clockNew-$clockOld)) <= 1)) ? "1" :

  1354 	"file:($fileOld=>$fileNew) clock:($clockOld=>$clockNew)"

  1355     }

  1356 } {1}

  1357 test cmdAH-24.3 {Tcl_FileObjCmd: mtime} {

  1358     catch {unset stat}

  1359     file stat $gorpfile stat

  1360     list [expr {[file mtime $gorpfile] == $stat(mtime)}] \

  1361 	    [expr {[file atime $gorpfile] == $stat(atime)}]

  1362 } {1 1}

  1363 test cmdAH-24.4 {Tcl_FileObjCmd: mtime} {

  1364     string tolower [list [catch {file mtime _bogus_} msg] $msg \

  1365 	    $errorCode]

  1366 } {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}

  1367 test cmdAH-24.5 {Tcl_FileObjCmd: mtime} {

  1368     # Under Unix, use a file in /tmp to avoid clock skew due to NFS.

  1369     # On other platforms, just use a file in the local directory.

  1371     if {[string equal $tcl_platform(platform) "unix"]} {

  1372 	set name /tmp/tcl.test.[pid]

  1373     } else {

  1374 	set name [file join [temporaryDirectory] tf]

  1375     }

  1377     # Make sure that a new file's time is correct.  10 seconds variance

  1378     # is allowed used due to slow networks or clock skew on a network drive.

  1380     file delete -force $name

  1381     close [open $name w]

  1382     set a [expr abs([clock seconds]-[file mtime $name])<10]

  1383     file delete $name

  1384     set a

  1385 } {1}

  1386 test cmdAH-24.7 {Tcl_FileObjCmd: mtime} {

  1387     list [catch {file mtime $file notint} msg] $msg

  1388 } {1 {expected integer but got "notint"}}

  1389 test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} macOrUnix {

  1390     set mtime [file mtime $file]

  1391     after 1100; # pause a sec to notice change in mtime

  1392     set newmtime [clock seconds]

  1393     set modmtime [file mtime $file $newmtime]

  1394     expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}

  1395 } 1

  1396 test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} macOrUnix {

  1397     set oldfile $file

  1398     # introduce some non-ascii characters.

  1399     append file \u2022

  1400     file delete -force $file

  1401     file rename $oldfile $file

  1402     set mtime [file mtime $file]

  1403     after 1100; # pause a sec to notice change in mtime

  1404     set newmtime [clock seconds]

  1405     set err [catch {file mtime $file $newmtime} modmtime]

  1406     file rename $file $oldfile

  1407     if {$err} {

  1408 	error $modmtime

  1409     }

  1410     expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}

  1411 } 1

  1412 test cmdAH-24.10 {Tcl_FileObjCmd: mtime touch} winOnly {

  1413     waitForEvenSecondForFAT

  1414     set mtime [file mtime $file]

  1415     after 2100; # pause two secs to notice change in mtime on FAT fs'es

  1416     set newmtime [clock seconds]

  1417     set modmtime [file mtime $file $newmtime]

  1418     expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}

  1419 } 1

  1420 test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} winOnly {

  1421     waitForEvenSecondForFAT

  1422     set oldfile $file

  1423     # introduce some non-ascii characters.

  1424     append file \u2022

  1425     file delete -force $file

  1426     file rename $oldfile $file

  1427     set mtime [file mtime $file]

  1428     after 2100; # pause two secs to notice change in mtime on FAT fs'es

  1429     set newmtime [clock seconds]

  1430     set err [catch {file mtime $file $newmtime} modmtime]

  1431     file rename $file $oldfile

  1432     if {$err} {

  1433 	error $modmtime

  1434     }

  1435     expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}

  1436 } 1

  1437 removeFile touch.me

  1438 rename waitForEvenSecondForFAT {}

  1440 test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} {

  1441     set name [file join [temporaryDirectory] clockchange]

  1443     file delete -force $name

  1444     close [open $name w]

  1445     set time [clock scan "21:00:00 October 30 2004 GMT"]

  1446     file mtime $name $time

  1447     set newmtime [file mtime $name]

  1448     file delete $name

  1449     expr {$newmtime == $time ? 1 : "$newmtime != $time"}

  1450 } {1}

  1452 # bug 1420432: setting mtime fails for directories on windows.

  1453 test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} {

  1454     set dirname [file join [temporaryDirectory] tmp[pid]]

  1455     file delete -force $dirname

  1456     file mkdir $dirname

  1457     set res [catch {

  1458         set old [file mtime $dirname]

  1459         file mtime $dirname 0

  1460         set new [file mtime $dirname]

  1461         list $new [expr {$old != $new}]

  1462     } err]

  1463     file delete -force $dirname

  1464     list $res $err

  1465 } {0 {0 1}}

  1467 # owned

  1469 test cmdAH-25.1 {Tcl_FileObjCmd: owned} {

  1470     list [catch {file owned a b} msg] $msg

  1471 } {1 {wrong # args: should be "file owned name"}}

  1472 test cmdAH-25.2 {Tcl_FileObjCmd: owned} {

  1473     file owned $gorpfile

  1474 } 1

  1475 test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unixOnly notRoot} {

  1476     file owned /

  1477 } 0

  1479 # readlink

  1481 test cmdAH-26.1 {Tcl_FileObjCmd: readlink} {

  1482     list [catch {file readlink a b} msg] $msg

  1483 } {1 {wrong # args: should be "file readlink name"}}

  1484 test cmdAH-26.2 {Tcl_FileObjCmd: readlink} {unixOnly nonPortable} {

  1485     file readlink $linkfile

  1486 } $gorpfile

  1487 test cmdAH-26.3 {Tcl_FileObjCmd: readlink errors} {unixOnly nonPortable} {

  1488     list [catch {file readlink _bogus_} msg] [string tolower $msg] \

  1489 	    [string tolower $errorCode]

  1490 } {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}

  1491 test cmdAH-26.4 {Tcl_FileObjCmd: readlink errors} {macOnly nonPortable} {

  1492     list [catch {file readlink _bogus_} msg] [string tolower $msg] \

  1493 	    [string tolower $errorCode]

  1494 } {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}

  1495 test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {winOnly nonPortable} {

  1496     list [catch {file readlink _bogus_} msg] [string tolower $msg] \

  1497 	    [string tolower $errorCode]

  1498 } {1 {could not readlink "_bogus_": invalid argument} {posix einval {invalid argument}}}

  1500 # size

  1502 test cmdAH-27.1 {Tcl_FileObjCmd: size} {

  1503     list [catch {file size a b} msg] $msg

  1504 } {1 {wrong # args: should be "file size name"}}

  1505 test cmdAH-27.2 {Tcl_FileObjCmd: size} {

  1506     set oldsize [file size $gorpfile]

  1507     set f [open $gorpfile a]

  1508     fconfigure $f -translation lf -eofchar {}

  1509     puts $f "More text"

  1510     close $f

  1511     expr {[file size $gorpfile] - $oldsize}

  1512 } {10}

  1513 test cmdAH-27.3 {Tcl_FileObjCmd: size} {

  1514     string tolower [list [catch {file size _bogus_} msg] $msg \

  1515 	    $errorCode]

  1516 } {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}

  1518 # stat

  1520 catch {testsetplatform $platform}

  1521 removeFile $gorpfile

  1522 set gorpfile [makeFile "Test string" gorp.file]

  1523 catch {file attributes $gorpfile -permissions 0765}

  1525 test cmdAH-28.1 {Tcl_FileObjCmd: stat} {

  1526     list [catch {file stat _bogus_} msg] $msg $errorCode

  1527 } {1 {wrong # args: should be "file stat name varName"} NONE}

  1528 test cmdAH-28.2 {Tcl_FileObjCmd: stat} {

  1529     list [catch {file stat _bogus_ a b} msg] $msg $errorCode

  1530 } {1 {wrong # args: should be "file stat name varName"} NONE}

  1531 test cmdAH-28.3 {Tcl_FileObjCmd: stat} {

  1532     catch {unset stat}

  1533     file stat $gorpfile stat

  1534     lsort [array names stat]

  1535 } {atime ctime dev gid ino mode mtime nlink size type uid}

  1536 test cmdAH-28.4 {Tcl_FileObjCmd: stat} {

  1537     catch {unset stat}

  1538     file stat $gorpfile stat

  1539     list $stat(nlink) $stat(size) $stat(type)

  1540 } {1 12 file}

  1541 test cmdAH-28.5 {Tcl_FileObjCmd: stat} {unixOnly} {

  1542     catch {unset stat}

  1543     file stat $gorpfile stat

  1544     expr $stat(mode)&0777

  1545 } {501}

  1546 test cmdAH-28.6 {Tcl_FileObjCmd: stat} {

  1547     string tolower [list [catch {file stat _bogus_ stat} msg] \

  1548 	    $msg $errorCode]

  1549 } {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}

  1550 test cmdAH-28.7 {Tcl_FileObjCmd: stat} {

  1551     catch {unset x}

  1552     set x 44

  1553     list [catch {file stat $gorpfile x} msg] $msg $errorCode

  1554 } {1 {can't set "x(dev)": variable isn't array} NONE}

  1555 test cmdAH-28.8 {Tcl_FileObjCmd: stat} {

  1556     # Sign extension of purported unsigned short to int.

  1558     set filename [makeFile "" foo.text]

  1559     file stat $filename stat

  1560     set x [expr {$stat(mode) > 0}]

  1561     removeFile $filename

  1562     set x

  1563 } 1

  1564 test cmdAH-28.9 {Tcl_FileObjCmd: stat} winOnly {

  1565     # stat of root directory was failing.

  1566     # don't care about answer, just that test runs.

  1568     # relative paths that resolve to root

  1569     set old [pwd]

  1570     cd c:/

  1571     file stat c: stat

  1572     file stat c:. stat

  1573     file stat . stat

  1574     cd $old

  1576     file stat / stat

  1577     file stat c:/ stat

  1578     file stat c:/. stat

  1579 } {}

  1580 test cmdAH-28.10 {Tcl_FileObjCmd: stat} {winOnly nonPortable} {

  1581     # stat of root directory was failing.

  1582     # don't care about answer, just that test runs.

  1584     file stat //pop/$env(USERNAME) stat

  1585     file stat //pop/$env(USERNAME)/ stat

  1586     file stat //pop/$env(USERNAME)/. stat

  1587 } {}

  1588 test cmdAH-28.11 {Tcl_FileObjCmd: stat} {winOnly nonPortable} {

  1589     # stat of network directory was returning id of current local drive.

  1591     set old [pwd]

  1592     cd c:/

  1594     file stat //pop/$env(USERNAME) stat

  1595     cd $old

  1596     expr {$stat(dev) == 2}

  1597 } 0

  1598 test cmdAH-28.12 {Tcl_FileObjCmd: stat} {

  1599     # stat(mode) with S_IFREG flag was returned as a negative number

  1600     # if mode_t was a short instead of an unsigned short.

  1602     set filename [makeFile "" foo.test]

  1603     file stat $filename stat

  1604     removeFile $filename

  1605     expr {$stat(mode) > 0}

  1606 } 1

  1607 catch {unset stat}

  1609 # type

  1611 test cmdAH-29.1 {Tcl_FileObjCmd: type} {

  1612     list [catch {file size a b} msg] $msg

  1613 } {1 {wrong # args: should be "file size name"}}

  1614 test cmdAH-29.2 {Tcl_FileObjCmd: type} {

  1615     file type $dirfile

  1616 } directory

  1617 test cmdAH-29.3.0 {Tcl_FileObjCmd: delete removes link not file} {unixOnly nonPortable} {

  1618     set exists [list [file exists $linkfile] [file exists $gorpfile]]

  1619     file delete $linkfile

  1620     set exists2	[list [file exists $linkfile] [file exists $gorpfile]]

  1621     list $exists $exists2

  1622 } {{1 1} {0 1}}

  1623 test cmdAH-29.3 {Tcl_FileObjCmd: type} {

  1624     file type $gorpfile

  1625 } file

  1626 test cmdAH-29.4 {Tcl_FileObjCmd: type} {unixOnly} {

  1627     catch {file delete $linkfile}

  1628     # Unlike [exec ln -s], [file link] requires an existing target

  1629     file link -symbolic $linkfile $gorpfile

  1630     set result [file type $linkfile]

  1631     file delete $linkfile

  1632     set result

  1633 } link

  1634 if {[string equal $tcl_platform(platform) "windows"]} {

  1635     if {[string index $tcl_platform(osVersion) 0] >= 5 \

  1636       && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} {

  1637 	tcltest::testConstraint linkDirectory 1

  1638     } else {

  1639 	tcltest::testConstraint linkDirectory 0

  1640     }

  1641 } else {

  1642     tcltest::testConstraint linkDirectory 1

  1643 }

  1644 test cmdAH-29.4.1 {Tcl_FileObjCmd: type} {linkDirectory} {

  1645     set tempdir [makeDirectory temp]

  1646     set linkdir [file join [temporaryDirectory] link.dir]

  1647     file link -symbolic $linkdir $tempdir

  1648     set result [file type $linkdir]

  1649     file delete $linkdir

  1650     removeDirectory $tempdir

  1651     set result

  1652 } link

  1653 test cmdAH-29.5 {Tcl_FileObjCmd: type} {

  1654     string tolower [list [catch {file type _bogus_} msg] $msg $errorCode]

  1655 } {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}

  1657 # Error conditions

  1659 test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} {

  1660     list [catch {file gorp x} msg] $msg

  1661 } {1 {bad option "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}

  1662 test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} {

  1663     list [catch {file ex x} msg] $msg

  1664 } {1 {ambiguous option "ex": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}

  1665 test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} {

  1666     list [catch {file is x} msg] $msg

  1667 } {1 {ambiguous option "is": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}

  1668 test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} {

  1669     list [catch {file z x} msg] $msg

  1670 } {1 {bad option "z": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}

  1671 test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} {

  1672     list [catch {file read x} msg] $msg

  1673 } {1 {ambiguous option "read": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}

  1674 test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} {

  1675     list [catch {file s x} msg] $msg

  1676 } {1 {ambiguous option "s": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}

  1677 test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} {

  1678     list [catch {file t x} msg] $msg

  1679 } {1 {ambiguous option "t": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}

  1680 test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} {

  1681     list [catch {file dirname ~woohgy} msg] $msg

  1682 } {1 {user "woohgy" doesn't exist}}

  1684 # channels

  1685 # In testing 'file channels', we need to make sure that a channel

  1686 # created in one interp isn't visible in another.

  1688 interp create simpleInterp

  1689 interp create -safe safeInterp

  1690 interp c

  1691 safeInterp expose file file

  1693 test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} {

  1694     list [catch {file channels a b} msg] $msg

  1695 } {1 {wrong # args: should be "file channels ?pattern?"}}

  1696 test cmdAH-31.2 {Tcl_FileObjCmd: channels, too many args} {

  1697     # Normal interps start out with only the standard channels

  1698     lsort [simpleInterp eval [list file chan]]

  1699 } [lsort {stderr stdout stdin}]

  1700 test cmdAH-31.3 {Tcl_FileObjCmd: channels, globbing} {

  1701     string equal [file channels] [file channels *]

  1702 } {1}

  1703 test cmdAH-31.4 {Tcl_FileObjCmd: channels, globbing} {

  1704     lsort [file channels std*]

  1705 } [lsort {stdout stderr stdin}]

  1707 set newFileId [open $gorpfile w]

  1709 test cmdAH-31.5 {Tcl_FileObjCmd: channels} {

  1710     set res [file channels $newFileId]

  1711     string equal $newFileId $res

  1712 } {1}

  1713 test cmdAH-31.6 {Tcl_FileObjCmd: channels in other interp} {

  1714     # Safe interps start out with no channels

  1715     safeInterp eval [list file channels]

  1716 } {}

  1717 test cmdAH-31.7 {Tcl_FileObjCmd: channels in other interp} {

  1718     list [catch {safeInterp eval [list puts $newFileId "hello"]} msg] $msg

  1719 } [list 1 "can not find channel named \"$newFileId\""]

  1721 interp share {} $newFileId safeInterp

  1722 interp share {} stdout safeInterp

  1724 test cmdAH-31.8 {Tcl_FileObjCmd: channels in other interp} {

  1725     # $newFileId should now be visible in both interps

  1726     list [file channels $newFileId] \

  1727 	    [safeInterp eval [list file channels $newFileId]]

  1728 } [list $newFileId $newFileId]

  1729 test cmdAH-31.9 {Tcl_FileObjCmd: channels in other interp} {

  1730     lsort [safeInterp eval [list file channels]]

  1731 } [lsort [list stdout $newFileId]]

  1732 test cmdAH-31.10 {Tcl_FileObjCmd: channels in other interp} {

  1733     # we can now write to $newFileId from slave

  1734     safeInterp eval [list puts $newFileId "hello"]

  1735 } {}

  1737 interp transfer {} $newFileId safeInterp

  1739 test cmdAH-31.11 {Tcl_FileObjCmd: channels in other interp} {

  1740     # $newFileId should now be visible only in safeInterp

  1741     list [file channels $newFileId] \

  1742 	    [safeInterp eval [list file channels $newFileId]]

  1743 } [list {} $newFileId]

  1744 test cmdAH-31.12 {Tcl_FileObjCmd: channels in other interp} {

  1745     lsort [safeInterp eval [list file channels]]

  1746 } [lsort [list stdout $newFileId]]

  1747 test cmdAH-31.13 {Tcl_FileObjCmd: channels in other interp} {

  1748     safeInterp eval [list close $newFileId]

  1749     safeInterp eval [list file channels]

  1750 } {stdout}

  1752 # This shouldn't work, but just in case a test above failed...

  1753 catch {close $newFileId}

  1755 interp delete safeInterp

  1756 interp delete simpleInterp

  1758 # cleanup

  1759 catch {testsetplatform $platform}

  1760 catch {unset platform}

  1762 # Tcl_ForObjCmd is tested in for.test

  1764 catch {file attributes $dirfile -permissions 0777}

  1765 removeDirectory $dirfile

  1766 removeFile $gorpfile

  1767 # No idea how well [removeFile] copes with links...

  1768 file delete $linkfile

  1770 cd $cmdAHwd

  1772 ::tcltest::cleanupTests

  1773 return

author	sl
	Tue, 10 Jun 2014 14:32:02 +0200
changeset 1	260cb5ec6c19
permissions	-rw-r--r--