+++ /dev/null
-# The file tests the tclCmdAH.c file.
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
-#
-# Copyright (c) 1996-1998 by Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id$
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]]
-tcltest::testConstraint fsIsWritable [expr {1 - [catch {file mkdir isreadonly ; file delete isreadonly}]}]
-
-global env
-set cmdAHwd [pwd]
-catch {set platform [testgetplatform]}
-
-test cmdAH-0.1 {Tcl_BreakObjCmd, errors} {
- list [catch {break foo} msg] $msg
-} {1 {wrong # args: should be "break"}}
-test cmdAH-0.2 {Tcl_BreakObjCmd, success} {
- list [catch {break} msg] $msg
-} {3 {}}
-
-# Tcl_CaseObjCmd is tested in case.test
-
-test cmdAH-1.1 {Tcl_CatchObjCmd, errors} {
- list [catch {catch} msg] $msg
-} {1 {wrong # args: should be "catch command ?varName?"}}
-test cmdAH-1.2 {Tcl_CatchObjCmd, errors} {
- list [catch {catch foo bar baz} msg] $msg
-} {1 {wrong # args: should be "catch command ?varName?"}}
-
-test cmdAH-2.1 {Tcl_CdObjCmd} {
- list [catch {cd foo bar} msg] $msg
-} {1 {wrong # args: should be "cd ?dirName?"}}
-test cmdAH-2.2 {Tcl_CdObjCmd} {fsIsWritable} {
- file delete -force foo
- file mkdir foo
- cd foo
- set result [file tail [pwd]]
- cd ..
- file delete foo
- set result
-} foo
-test cmdAH-2.3 {Tcl_CdObjCmd} {fsIsWritable} {
- global env
- set oldpwd [pwd]
- set temp $env(HOME)
- set env(HOME) $oldpwd
- file delete -force foo
- file mkdir foo
- cd foo
- cd ~
- set result [string match [pwd] $oldpwd]
- file delete foo
- set env(HOME) $temp
- set result
-} 1
-test cmdAH-2.4 {Tcl_CdObjCmd} {fsIsWritable} {
- global env
- set oldpwd [pwd]
- set temp $env(HOME)
- set env(HOME) $oldpwd
- file delete -force foo
- file mkdir foo
- cd foo
- cd
- set result [string match [pwd] $oldpwd]
- file delete foo
- set env(HOME) $temp
- set result
-} 1
-test cmdAH-2.5 {Tcl_CdObjCmd} {
- list [catch {cd ~~} msg] $msg
-} {1 {user "~" doesn't exist}}
-test cmdAH-2.6 {Tcl_CdObjCmd} {
- list [catch {cd _foobar} msg] $msg
-} {1 {couldn't change working directory to "_foobar": no such file or directory}}
-
-test cmdAH-2.7 {Tcl_ConcatObjCmd} {
- concat
-} {}
-test cmdAH-2.8 {Tcl_ConcatObjCmd} {
- concat a
-} a
-test cmdAH-2.9 {Tcl_ConcatObjCmd} {
- concat a {b c}
-} {a b c}
-
-test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} {
- list [catch {continue foo} msg] $msg
-} {1 {wrong # args: should be "continue"}}
-test cmdAH-3.2 {Tcl_ContinueObjCmd, success} {
- list [catch {continue} msg] $msg
-} {4 {}}
-
-test cmdAH-4.1 {Tcl_EncodingObjCmd} {
- list [catch {encoding} msg] $msg
-} {1 {wrong # args: should be "encoding option ?arg ...?"}}
-test cmdAH-4.2 {Tcl_EncodingObjCmd} {
- list [catch {encoding foo} msg] $msg
-} {1 {bad option "foo": must be convertfrom, convertto, names, or system}}
-test cmdAH-4.3 {Tcl_EncodingObjCmd} {
- list [catch {encoding convertto} msg] $msg
-} {1 {wrong # args: should be "encoding convertto ?encoding? data"}}
-test cmdAH-4.4 {Tcl_EncodingObjCmd} {
- list [catch {encoding convertto foo bar} msg] $msg
-} {1 {unknown encoding "foo"}}
-test cmdAH-4.5 {Tcl_EncodingObjCmd} {
- set system [encoding system]
- encoding system jis0208
- set x [encoding convertto \u4e4e]
- encoding system $system
- set x
-} 8C
-test cmdAH-4.6 {Tcl_EncodingObjCmd} {
- set system [encoding system]
- encoding system identity
- set x [encoding convertto jis0208 \u4e4e]
- encoding system $system
- set x
-} 8C
-test cmdAH-4.7 {Tcl_EncodingObjCmd} {
- list [catch {encoding convertfrom} msg] $msg
-} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"}}
-test cmdAH-4.8 {Tcl_EncodingObjCmd} {
- list [catch {encoding convertfrom foo bar} msg] $msg
-} {1 {unknown encoding "foo"}}
-test cmdAH-4.9 {Tcl_EncodingObjCmd} {
- set system [encoding system]
- encoding system jis0208
- set x [encoding convertfrom 8C]
- encoding system $system
- set x
-} \u4e4e
-test cmdAH-4.10 {Tcl_EncodingObjCmd} {
- set system [encoding system]
- encoding system identity
- set x [encoding convertfrom jis0208 8C]
- encoding system $system
- set x
-} \u4e4e
-test cmdAH-4.11 {Tcl_EncodingObjCmd} {
- list [catch {encoding names foo} msg] $msg
-} {1 {wrong # args: should be "encoding names"}}
-test cmdAH-4.12 {Tcl_EncodingObjCmd} {
- list [catch {encoding system foo bar} msg] $msg
-} {1 {wrong # args: should be "encoding system ?encoding?"}}
-test cmdAH-4.13 {Tcl_EncodingObjCmd} {
- set system [encoding system]
- encoding system identity
- set x [encoding system]
- encoding system $system
- set x
-} identity
-
-test cmdAH-5.1 {Tcl_FileObjCmd} {
- list [catch file msg] $msg
-} {1 {wrong # args: should be "file option ?arg ...?"}}
-test cmdAH-5.2 {Tcl_FileObjCmd} {
- list [catch {file x} msg] $msg
-} {1 {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
-test cmdAH-5.3 {Tcl_FileObjCmd} {
- list [catch {file exists} msg] $msg
-} {1 {wrong # args: should be "file exists name"}}
-test cmdAH-5.4 {Tcl_FileObjCmd} {
- list [catch {file exists ""} msg] $msg
-} {0 0}
-
-#volume
-
-test cmdAH-6.1 {Tcl_FileObjCmd: volumes} {
- list [catch {file volumes x} msg] $msg
-} {1 {wrong # args: should be "file volumes"}}
-test cmdAH-6.2 {Tcl_FileObjCmd: volumes} {
- set volumeList [file volumes]
- if { [llength $volumeList] == 0 } {
- set result 0
- } else {
- set result 1
- }
-} {1}
-test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {macOrUnix} {
- set volumeList [file volumes]
- catch [list glob -nocomplain [lindex $volumeList 0]*]
-} {0}
-test cmdAH-6.4 {Tcl_FileObjCmd: volumes} {pcOnly} {
- set volumeList [string tolower [file volumes]]
- list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}]
-} {0 1 0}
-
-# attributes
-
-test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} {fsIsWritable} {
- catch {file delete -force foo.file}
- close [open foo.file w]
- list [catch {file attributes foo.file}] [file delete -force foo.file]
-} {0 {}}
-
-# dirname
-
-if {[info commands testsetplatform] == {}} {
- puts "This application hasn't been compiled with the \"testsetplatform\""
- puts "command, so I can't test Tcl_FileObjCmd etc."
-} else {
-test cmdAH-8.1 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- list [catch {file dirname a b} msg] $msg
-} {1 {wrong # args: should be "file dirname name"}}
-test cmdAH-8.2 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- file dirname /a/b
-} /a
-test cmdAH-8.3 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- file dirname {}
-} .
-test cmdAH-8.4 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- file dirname {}
-} :
-test cmdAH-8.5 {Tcl_FileObjCmd: dirname} {
- testsetplatform win
- file dirname {}
-} .
-test cmdAH-8.6 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- file dirname .def
-} .
-test cmdAH-8.7 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- file dirname a
-} :
-test cmdAH-8.8 {Tcl_FileObjCmd: dirname} {
- testsetplatform win
- file dirname a
-} .
-test cmdAH-8.9 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- file dirname a/b/c.d
-} a/b
-test cmdAH-8.10 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- file dirname a/b.c/d
-} a/b.c
-test cmdAH-8.11 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- file dirname /.
-} /
-test cmdAH-8.12 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- list [catch {file dirname /} msg] $msg
-} {0 /}
-test cmdAH-8.13 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- list [catch {file dirname /foo} msg] $msg
-} {0 /}
-test cmdAH-8.14 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- list [catch {file dirname //foo} msg] $msg
-} {0 /}
-test cmdAH-8.15 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- list [catch {file dirname //foo/bar} msg] $msg
-} {0 /foo}
-test cmdAH-8.16 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- list [catch {file dirname {//foo\/bar/baz}} msg] $msg
-} {0 {/foo\/bar}}
-test cmdAH-8.17 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- list [catch {file dirname {//foo\/bar/baz/blat}} msg] $msg
-} {0 {/foo\/bar/baz}}
-test cmdAH-8.18 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- list [catch {file dirname /foo//} msg] $msg
-} {0 /}
-test cmdAH-8.19 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- list [catch {file dirname ./a} msg] $msg
-} {0 .}
-test cmdAH-8.20 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- list [catch {file dirname a/.a} msg] $msg
-} {0 a}
-test cmdAH-8.21 {Tcl_FileObjCmd: dirname} {
- testsetplatform windows
- list [catch {file dirname c:foo} msg] $msg
-} {0 c:}
-test cmdAH-8.22 {Tcl_FileObjCmd: dirname} {
- testsetplatform windows
- list [catch {file dirname c:} msg] $msg
-} {0 c:}
-test cmdAH-8.23 {Tcl_FileObjCmd: dirname} {
- testsetplatform windows
- list [catch {file dirname c:/} msg] $msg
-} {0 c:/}
-test cmdAH-8.24 {Tcl_FileObjCmd: dirname} {
- testsetplatform windows
- list [catch {file dirname {c:\foo}} msg] $msg
-} {0 c:/}
-test cmdAH-8.25 {Tcl_FileObjCmd: dirname} {
- testsetplatform windows
- list [catch {file dirname {//foo/bar/baz}} msg] $msg
-} {0 //foo/bar}
-test cmdAH-8.26 {Tcl_FileObjCmd: dirname} {
- testsetplatform windows
- list [catch {file dirname {//foo/bar}} msg] $msg
-} {0 //foo/bar}
-test cmdAH-8.27 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- list [catch {file dirname :} msg] $msg
-} {0 :}
-test cmdAH-8.28 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- list [catch {file dirname :Foo} msg] $msg
-} {0 :}
-test cmdAH-8.29 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- list [catch {file dirname Foo:} msg] $msg
-} {0 Foo:}
-test cmdAH-8.30 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- list [catch {file dirname Foo:bar} msg] $msg
-} {0 Foo:}
-test cmdAH-8.31 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- list [catch {file dirname :Foo:bar} msg] $msg
-} {0 :Foo}
-test cmdAH-8.32 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- list [catch {file dirname ::} msg] $msg
-} {0 :}
-test cmdAH-8.33 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- list [catch {file dirname :::} msg] $msg
-} {0 ::}
-test cmdAH-8.34 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- list [catch {file dirname /foo/bar/} msg] $msg
-} {0 foo:}
-test cmdAH-8.35 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- list [catch {file dirname /foo/bar} msg] $msg
-} {0 foo:}
-test cmdAH-8.36 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- list [catch {file dirname /foo} msg] $msg
-} {0 foo:}
-test cmdAH-8.37 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- list [catch {file dirname foo} msg] $msg
-} {0 :}
-test cmdAH-8.38 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- list [catch {file dirname ~/foo} msg] $msg
-} {0 ~}
-test cmdAH-8.39 {Tcl_FileObjCmd: dirname} {
- testsetplatform unix
- list [catch {file dirname ~bar/foo} msg] $msg
-} {0 ~bar}
-test cmdAH-8.40 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- list [catch {file dirname ~bar/foo} msg] $msg
-} {0 ~bar:}
-test cmdAH-8.41 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- list [catch {file dirname ~/foo} msg] $msg
-} {0 ~:}
-test cmdAH-8.42 {Tcl_FileObjCmd: dirname} {
- testsetplatform mac
- list [catch {file dirname ~:baz} msg] $msg
-} {0 ~:}
-test cmdAH-8.43 {Tcl_FileObjCmd: dirname} {
- global env
- set temp $env(HOME)
- set env(HOME) "/home/test"
- testsetplatform unix
- set result [list [catch {file dirname ~} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 /home}
-test cmdAH-8.44 {Tcl_FileObjCmd: dirname} {
- global env
- set temp $env(HOME)
- set env(HOME) "~"
- testsetplatform unix
- set result [list [catch {file dirname ~} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 ~}
-test cmdAH-8.45 {Tcl_FileObjCmd: dirname} {
- global env
- set temp $env(HOME)
- set env(HOME) "/home/test"
- testsetplatform windows
- set result [list [catch {file dirname ~} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 /home}
-test cmdAH-8.46 {Tcl_FileObjCmd: dirname} {
- global env
- set temp $env(HOME)
- set env(HOME) "/home/test"
- testsetplatform mac
- set result [list [catch {file dirname ~} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 home:}
-
-# tail
-
-test cmdAH-9.1 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- list [catch {file tail a b} msg] $msg
-} {1 {wrong # args: should be "file tail name"}}
-test cmdAH-9.2 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file tail /a/b
-} b
-test cmdAH-9.3 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file tail {}
-} {}
-test cmdAH-9.4 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail {}
-} {}
-test cmdAH-9.5 {Tcl_FileObjCmd: tail} {
- testsetplatform win
- file tail {}
-} {}
-test cmdAH-9.6 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file tail .def
-} .def
-test cmdAH-9.7 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail a
-} a
-test cmdAH-9.8 {Tcl_FileObjCmd: tail} {
- testsetplatform win
- file tail a
-} a
-test cmdAH-9.9 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file ta a/b/c.d
-} c.d
-test cmdAH-9.10 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file tail a/b.c/d
-} d
-test cmdAH-9.11 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file tail /.
-} .
-test cmdAH-9.12 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file tail /
-} {}
-test cmdAH-9.13 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file tail /foo
-} foo
-test cmdAH-9.14 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file tail //foo
-} foo
-test cmdAH-9.15 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file tail //foo/bar
-} bar
-test cmdAH-9.16 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file tail {//foo\/bar/baz}
-} baz
-test cmdAH-9.17 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file tail {//foo\/bar/baz/blat}
-} blat
-test cmdAH-9.18 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file tail /foo//
-} foo
-test cmdAH-9.19 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file tail ./a
-} a
-test cmdAH-9.20 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file tail a/.a
-} .a
-test cmdAH-9.21 {Tcl_FileObjCmd: tail} {
- testsetplatform windows
- file tail c:foo
-} foo
-test cmdAH-9.22 {Tcl_FileObjCmd: tail} {
- testsetplatform windows
- file tail c:
-} {}
-test cmdAH-9.23 {Tcl_FileObjCmd: tail} {
- testsetplatform windows
- file tail c:/
-} {}
-test cmdAH-9.24 {Tcl_FileObjCmd: tail} {
- testsetplatform windows
- file tail {c:\foo}
-} foo
-test cmdAH-9.25 {Tcl_FileObjCmd: tail} {
- testsetplatform windows
- file tail {//foo/bar/baz}
-} baz
-test cmdAH-9.26 {Tcl_FileObjCmd: tail} {
- testsetplatform windows
- file tail {//foo/bar}
-} {}
-test cmdAH-9.27 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail :
-} :
-test cmdAH-9.28 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail :Foo
-} Foo
-test cmdAH-9.29 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail Foo:
-} {}
-test cmdAH-9.30 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail Foo:bar
-} bar
-test cmdAH-9.31 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail :Foo:bar
-} bar
-test cmdAH-9.32 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail ::
-} ::
-test cmdAH-9.33 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail :::
-} ::
-test cmdAH-9.34 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail /foo/bar/
-} bar
-test cmdAH-9.35 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail /foo/bar
-} bar
-test cmdAH-9.36 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail /foo
-} {}
-test cmdAH-9.37 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail foo
-} foo
-test cmdAH-9.38 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail ~:foo
-} foo
-test cmdAH-9.39 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail ~bar:foo
-} foo
-test cmdAH-9.40 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail ~bar/foo
-} foo
-test cmdAH-9.41 {Tcl_FileObjCmd: tail} {
- testsetplatform mac
- file tail ~/foo
-} foo
-test cmdAH-9.42 {Tcl_FileObjCmd: tail} {
- global env
- set temp $env(HOME)
- set env(HOME) "/home/test"
- testsetplatform unix
- set result [file tail ~]
- set env(HOME) $temp
- set result
-} test
-test cmdAH-9.43 {Tcl_FileObjCmd: tail} {
- global env
- set temp $env(HOME)
- set env(HOME) "~"
- testsetplatform unix
- set result [file tail ~]
- set env(HOME) $temp
- set result
-} {}
-test cmdAH-9.44 {Tcl_FileObjCmd: tail} {
- global env
- set temp $env(HOME)
- set env(HOME) "/home/test"
- testsetplatform windows
- set result [file tail ~]
- set env(HOME) $temp
- set result
-} test
-test cmdAH-9.45 {Tcl_FileObjCmd: tail} {
- global env
- set temp $env(HOME)
- set env(HOME) "/home/test"
- testsetplatform mac
- set result [file tail ~]
- set env(HOME) $temp
- set result
-} test
-test cmdAH-9.46 {Tcl_FileObjCmd: tail} {
- testsetplatform unix
- file tail {f.oo\bar/baz.bat}
-} baz.bat
-test cmdAH-9.47 {Tcl_FileObjCmd: tail} {
- testsetplatform windows
- file tail c:foo
-} foo
-test cmdAH-9.48 {Tcl_FileObjCmd: tail} {
- testsetplatform windows
- file tail c:
-} {}
-test cmdAH-9.49 {Tcl_FileObjCmd: tail} {
- testsetplatform windows
- file tail c:/foo
-} foo
-test cmdAH-9.50 {Tcl_FileObjCmd: tail} {
- testsetplatform windows
- file tail {c:/foo\bar}
-} bar
-test cmdAH-9.51 {Tcl_FileObjCmd: tail} {
- testsetplatform windows
- file tail {foo\bar}
-} bar
-
-# rootname
-
-test cmdAH-10.1 {Tcl_FileObjCmd: rootname} {
- testsetplatform unix
- list [catch {file rootname a b} msg] $msg
-} {1 {wrong # args: should be "file rootname name"}}
-test cmdAH-10.2 {Tcl_FileObjCmd: rootname} {
- testsetplatform unix
- file rootname {}
-} {}
-test cmdAH-10.3 {Tcl_FileObjCmd: rootname} {
- testsetplatform unix
- file ro foo
-} foo
-test cmdAH-10.4 {Tcl_FileObjCmd: rootname} {
- testsetplatform unix
- file rootname foo.
-} foo
-test cmdAH-10.5 {Tcl_FileObjCmd: rootname} {
- testsetplatform unix
- file rootname .foo
-} {}
-test cmdAH-10.6 {Tcl_FileObjCmd: rootname} {
- testsetplatform unix
- file rootname abc.def
-} abc
-test cmdAH-10.7 {Tcl_FileObjCmd: rootname} {
- testsetplatform unix
- file rootname abc.def.ghi
-} abc.def
-test cmdAH-10.8 {Tcl_FileObjCmd: rootname} {
- testsetplatform unix
- file rootname a/b/c.d
-} a/b/c
-test cmdAH-10.9 {Tcl_FileObjCmd: rootname} {
- testsetplatform unix
- file rootname a/b.c/d
-} a/b.c/d
-test cmdAH-10.10 {Tcl_FileObjCmd: rootname} {
- testsetplatform unix
- file rootname a/b.c/
-} a/b.c/
-test cmdAH-10.11 {Tcl_FileObjCmd: rootname} {
- testsetplatform mac
- file ro foo
-} foo
-test cmdAH-10.12 {Tcl_FileObjCmd: rootname} {
- testsetplatform mac
- file rootname {}
-} {}
-test cmdAH-10.13 {Tcl_FileObjCmd: rootname} {
- testsetplatform mac
- file rootname foo.
-} foo
-test cmdAH-10.14 {Tcl_FileObjCmd: rootname} {
- testsetplatform mac
- file rootname .foo
-} {}
-test cmdAH-10.15 {Tcl_FileObjCmd: rootname} {
- testsetplatform mac
- file rootname abc.def
-} abc
-test cmdAH-10.16 {Tcl_FileObjCmd: rootname} {
- testsetplatform mac
- file rootname abc.def.ghi
-} abc.def
-test cmdAH-10.17 {Tcl_FileObjCmd: rootname} {
- testsetplatform mac
- file rootname a:b:c.d
-} a:b:c
-test cmdAH-10.18 {Tcl_FileObjCmd: rootname} {
- testsetplatform mac
- file rootname a:b.c:d
-} a:b.c:d
-test cmdAH-10.19 {Tcl_FileObjCmd: rootname} {
- testsetplatform mac
- file rootname a/b/c.d
-} a/b/c
-test cmdAH-10.20 {Tcl_FileObjCmd: rootname} {
- testsetplatform mac
- file rootname a/b.c/d
-} a/b.c/d
-test cmdAH-10.21 {Tcl_FileObjCmd: rootname} {
- testsetplatform mac
- file rootname /a.b
-} /a
-test cmdAH-10.22 {Tcl_FileObjCmd: rootname} {
- testsetplatform mac
- file rootname foo.c:
-} foo.c:
-test cmdAH-10.23 {Tcl_FileObjCmd: rootname} {
- testsetplatform windows
- file rootname {}
-} {}
-test cmdAH-10.24 {Tcl_FileObjCmd: rootname} {
- testsetplatform windows
- file ro foo
-} foo
-test cmdAH-10.25 {Tcl_FileObjCmd: rootname} {
- testsetplatform windows
- file rootname foo.
-} foo
-test cmdAH-10.26 {Tcl_FileObjCmd: rootname} {
- testsetplatform windows
- file rootname .foo
-} {}
-test cmdAH-10.27 {Tcl_FileObjCmd: rootname} {
- testsetplatform windows
- file rootname abc.def
-} abc
-test cmdAH-10.28 {Tcl_FileObjCmd: rootname} {
- testsetplatform windows
- file rootname abc.def.ghi
-} abc.def
-test cmdAH-10.29 {Tcl_FileObjCmd: rootname} {
- testsetplatform windows
- file rootname a/b/c.d
-} a/b/c
-test cmdAH-10.30 {Tcl_FileObjCmd: rootname} {
- testsetplatform windows
- file rootname a/b.c/d
-} a/b.c/d
-test cmdAH-10.31 {Tcl_FileObjCmd: rootname} {
- testsetplatform windows
- file rootname a\\b.c\\
-} a\\b.c\\
-test cmdAH-10.32 {Tcl_FileObjCmd: rootname} {
- testsetplatform windows
- file rootname a\\b\\c.d
-} a\\b\\c
-test cmdAH-10.33 {Tcl_FileObjCmd: rootname} {
- testsetplatform windows
- file rootname a\\b.c\\d
-} a\\b.c\\d
-test cmdAH-10.34 {Tcl_FileObjCmd: rootname} {
- testsetplatform windows
- file rootname a\\b.c\\
-} a\\b.c\\
-set num 35
-foreach outer { {} a .a a. a.a } {
- foreach inner { {} a .a a. a.a } {
- set thing [format %s/%s $outer $inner]
-; test cmdAH-6.$num {Tcl_FileObjCmd: rootname and extension options} {
- testsetplatform unix
- format %s%s [file rootname $thing] [file ext $thing]
- } $thing
- set num [expr $num+1]
- }
-}
-
-# extension
-
-test cmdAH-11.1 {Tcl_FileObjCmd: extension} {
- testsetplatform unix
- list [catch {file extension a b} msg] $msg
-} {1 {wrong # args: should be "file extension name"}}
-test cmdAH-11.2 {Tcl_FileObjCmd: extension} {
- testsetplatform unix
- file extension {}
-} {}
-test cmdAH-11.3 {Tcl_FileObjCmd: extension} {
- testsetplatform unix
- file ext foo
-} {}
-test cmdAH-11.4 {Tcl_FileObjCmd: extension} {
- testsetplatform unix
- file extension foo.
-} .
-test cmdAH-11.5 {Tcl_FileObjCmd: extension} {
- testsetplatform unix
- file extension .foo
-} .foo
-test cmdAH-11.6 {Tcl_FileObjCmd: extension} {
- testsetplatform unix
- file extension abc.def
-} .def
-test cmdAH-11.7 {Tcl_FileObjCmd: extension} {
- testsetplatform unix
- file extension abc.def.ghi
-} .ghi
-test cmdAH-11.8 {Tcl_FileObjCmd: extension} {
- testsetplatform unix
- file extension a/b/c.d
-} .d
-test cmdAH-11.9 {Tcl_FileObjCmd: extension} {
- testsetplatform unix
- file extension a/b.c/d
-} {}
-test cmdAH-11.10 {Tcl_FileObjCmd: extension} {
- testsetplatform unix
- file extension a/b.c/
-} {}
-test cmdAH-11.11 {Tcl_FileObjCmd: extension} {
- testsetplatform mac
- file ext foo
-} {}
-test cmdAH-11.12 {Tcl_FileObjCmd: extension} {
- testsetplatform mac
- file extension {}
-} {}
-test cmdAH-11.13 {Tcl_FileObjCmd: extension} {
- testsetplatform mac
- file extension foo.
-} .
-test cmdAH-11.14 {Tcl_FileObjCmd: extension} {
- testsetplatform mac
- file extension .foo
-} .foo
-test cmdAH-11.15 {Tcl_FileObjCmd: extension} {
- testsetplatform mac
- file extension abc.def
-} .def
-test cmdAH-11.16 {Tcl_FileObjCmd: extension} {
- testsetplatform mac
- file extension abc.def.ghi
-} .ghi
-test cmdAH-11.17 {Tcl_FileObjCmd: extension} {
- testsetplatform mac
- file extension a:b:c.d
-} .d
-test cmdAH-11.18 {Tcl_FileObjCmd: extension} {
- testsetplatform mac
- file extension a:b.c:d
-} {}
-test cmdAH-11.19 {Tcl_FileObjCmd: extension} {
- testsetplatform mac
- file extension a/b/c.d
-} .d
-test cmdAH-11.20 {Tcl_FileObjCmd: extension} {
- testsetplatform mac
- file extension a/b.c/d
-} {}
-test cmdAH-11.21 {Tcl_FileObjCmd: extension} {
- testsetplatform mac
- file extension /a.b
-} .b
-test cmdAH-11.22 {Tcl_FileObjCmd: extension} {
- testsetplatform mac
- file extension foo.c:
-} {}
-test cmdAH-11.23 {Tcl_FileObjCmd: extension} {
- testsetplatform windows
- file extension {}
-} {}
-test cmdAH-11.24 {Tcl_FileObjCmd: extension} {
- testsetplatform windows
- file ext foo
-} {}
-test cmdAH-11.25 {Tcl_FileObjCmd: extension} {
- testsetplatform windows
- file extension foo.
-} .
-test cmdAH-11.26 {Tcl_FileObjCmd: extension} {
- testsetplatform windows
- file extension .foo
-} .foo
-test cmdAH-11.27 {Tcl_FileObjCmd: extension} {
- testsetplatform windows
- file extension abc.def
-} .def
-test cmdAH-11.28 {Tcl_FileObjCmd: extension} {
- testsetplatform windows
- file extension abc.def.ghi
-} .ghi
-test cmdAH-11.29 {Tcl_FileObjCmd: extension} {
- testsetplatform windows
- file extension a/b/c.d
-} .d
-test cmdAH-11.30 {Tcl_FileObjCmd: extension} {
- testsetplatform windows
- file extension a/b.c/d
-} {}
-test cmdAH-11.31 {Tcl_FileObjCmd: extension} {
- testsetplatform windows
- file extension a\\b.c\\
-} {}
-test cmdAH-11.32 {Tcl_FileObjCmd: extension} {
- testsetplatform windows
- file extension a\\b\\c.d
-} .d
-test cmdAH-11.33 {Tcl_FileObjCmd: extension} {
- testsetplatform windows
- file extension a\\b.c\\d
-} {}
-test cmdAH-11.34 {Tcl_FileObjCmd: extension} {
- testsetplatform windows
- file extension a\\b.c\\
-} {}
-set num 35
-foreach value {a..b a...b a.c..b ..b} result {.b .b .b .b} {
- foreach p {unix mac windows} {
-; test cmdAH-7.$num {Tcl_FileObjCmd: extension} "
- testsetplatform $p
- file extension $value
- " $result
- incr num
- }
-}
-
-# pathtype
-
-test cmdAH-12.1 {Tcl_FileObjCmd: pathtype} {
- testsetplatform unix
- list [catch {file pathtype a b} msg] $msg
-} {1 {wrong # args: should be "file pathtype name"}}
-test cmdAH-12.2 {Tcl_FileObjCmd: pathtype} {
- testsetplatform unix
- file pathtype /a
-} absolute
-test cmdAH-12.3 {Tcl_FileObjCmd: pathtype} {
- testsetplatform unix
- file p a
-} relative
-test cmdAH-12.4 {Tcl_FileObjCmd: pathtype} {
- testsetplatform windows
- file pathtype c:a
-} volumerelative
-
-# split
-
-test cmdAH-13.1 {Tcl_FileObjCmd: split} {
- testsetplatform unix
- list [catch {file split a b} msg] $msg
-} {1 {wrong # args: should be "file split name"}}
-test cmdAH-13.2 {Tcl_FileObjCmd: split} {
- testsetplatform unix
- file split a
-} a
-test cmdAH-13.3 {Tcl_FileObjCmd: split} {
- testsetplatform unix
- file split a/b
-} {a b}
-
-# join
-
-test cmdAH-14.1 {Tcl_FileObjCmd: join} {
- testsetplatform unix
- file join a
-} a
-test cmdAH-14.2 {Tcl_FileObjCmd: join} {
- testsetplatform unix
- file join a b
-} a/b
-test cmdAH-14.3 {Tcl_FileObjCmd: join} {
- testsetplatform unix
- file join a b c d
-} a/b/c/d
-
-# error handling of Tcl_TranslateFileName
-
-test cmdAH-15.1 {Tcl_FileObjCmd} {
- testsetplatform unix
- list [catch {file atime ~_bad_user} msg] $msg
-} {1 {user "_bad_user" doesn't exist}}
-
-testsetplatform $platform
-}
-
-# readable
-
-catch {
- makeFile abcde gorp.file
- makeDirectory dir.file
-}
-
-test cmdAH-16.1 {Tcl_FileObjCmd: readable} {testchmod fsIsWritable} {
- list [catch {file readable a b} msg] $msg
-} {1 {wrong # args: should be "file readable name"}}
-catch {testchmod 444 gorp.file}
-test cmdAH-16.2 {Tcl_FileObjCmd: readable} {testchmod fsIsWritable} {
- file readable gorp.file
-} 1
-catch {testchmod 333 gorp.file}
-test cmdAH-16.3 {Tcl_FileObjCmd: readable} {unixOnly notRoot testchmod fsIsWritable} {
- file reada gorp.file
-} 0
-
-# writable
-
-test cmdAH-17.1 {Tcl_FileObjCmd: writable} {testchmod} {
- list [catch {file writable a b} msg] $msg
-} {1 {wrong # args: should be "file writable name"}}
-catch {testchmod 555 gorp.file}
-test cmdAH-17.2 {Tcl_FileObjCmd: writable} {notRoot testchmod fsIsWritable} {
- file writable gorp.file
-} 0
-catch {testchmod 222 gorp.file}
-test cmdAH-17.3 {Tcl_FileObjCmd: writable} {testchmod fsIsWritable} {
- file writable gorp.file
-} 1
-
-# executable
-
-catch {
- file delete -force dir.file gorp.file
- file mkdir dir.file
- makeFile abcde gorp.file
-}
-
-test cmdAH-18.1 {Tcl_FileObjCmd: executable} {testchmod} {
- list [catch {file executable a b} msg] $msg
-} {1 {wrong # args: should be "file executable name"}}
-test cmdAH-18.2 {Tcl_FileObjCmd: executable} {testchmod fsIsWritable} {
- file executable gorp.file
-} 0
-test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unixOnly testchmod fsIsWritable} {
- # Only on unix will setting the execute bit on a regular file
- # cause that file to be executable.
-
- testchmod 775 gorp.file
- file exe gorp.file
-} 1
-
-test cmdAH-18.4 {Tcl_FileObjCmd: executable} {macOnly testchmod} {
- # On mac, the only executable files are of type APPL.
-
- set x [file exe gorp.file]
- file attrib gorp.file -type APPL
- lappend x [file exe gorp.file]
-} {0 1}
-test cmdAH-18.5 {Tcl_FileObjCmd: executable} {pcOnly testchmod} {
- # On pc, must be a .exe, .com, etc.
-
- set x [file exe gorp.file]
- makeFile foo gorp.exe
- lappend x [file exe gorp.exe]
- file delete gorp.exe
- set x
-} {0 1}
-test cmdAH-18.6 {Tcl_FileObjCmd: executable} {testchmod} {
- # Directories are always executable.
-
- file exe dir.file
-} 1
-
-file delete -force dir.file
-file delete gorp.file
-file delete link.file
-
-# exists
-
-test cmdAH-19.1 {Tcl_FileObjCmd: exists} {
- list [catch {file exists a b} msg] $msg
-} {1 {wrong # args: should be "file exists name"}}
-test cmdAH-19.2 {Tcl_FileObjCmd: exists} {file exists gorp.file} 0
-test cmdAH-19.3 {Tcl_FileObjCmd: exists} {
- file exists [file join dir.file gorp.file]
-} 0
-catch {
- makeFile abcde gorp.file
- makeDirectory dir.file
- makeFile 12345 [file join dir.file gorp.file]
-}
-test cmdAH-19.4 {Tcl_FileObjCmd: exists} {fsIsWritable} {
- file exists gorp.file
-} 1
-test cmdAH-19.5 {Tcl_FileObjCmd: exists} {fsIsWritable} {
- file exists [file join dir.file gorp.file]
-} 1
-
-# nativename
-if {[info commands testsetplatform] == {}} {
- puts "This application hasn't been compiled with the \"testsetplatform\""
- puts "command, so I can't test Tcl_FileObjCmd etc."
-} else {
-test cmdAH-19.6 {Tcl_FileObjCmd: nativename} {
- testsetplatform unix
- list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
-} {0 a/b {}}
-test cmdAH-19.7 {Tcl_FileObjCmd: nativename} {
- testsetplatform windows
- list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
-} {0 {a\b} {}}
-test cmdAH-19.8 {Tcl_FileObjCmd: nativename} {
- testsetplatform mac
- list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
-} {0 :a:b {}}
-}
-
-test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} {
- file exists ~nOsUcHuSeR
-} 0
-test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} {
- # should probably be 0 in fact...
- catch {file nativename ~nOsUcHuSeR}
-} 1
-
-# The test below has to be done in /tmp rather than the current
-# directory in order to guarantee (?) a local file system: some
-# NFS file systems won't do the stuff below correctly.
-
-test cmdAH-19.11 {Tcl_FileObjCmd: exists} {unixOnly notRoot} {
- removeFile /tmp/tcl.foo.dir/file
- removeDirectory /tmp/tcl.foo.dir
- makeDirectory /tmp/tcl.foo.dir
- makeFile 12345 /tmp/tcl.foo.dir/file
- exec chmod 000 /tmp/tcl.foo.dir
-
- set result [file exists /tmp/tcl.foo.dir/file]
-
- exec chmod 775 /tmp/tcl.foo.dir
- removeFile /tmp/tcl.foo.dir/file
- removeDirectory /tmp/tcl.foo.dir
- set result
-} 0
-
-# Stat related commands
-
-catch {testsetplatform $platform}
-file delete gorp.file
-catch {makeFile "Test string" gorp.file}
-catch {exec chmod 765 gorp.file}
-
-# atime
-
-catch {set file [makeFile "data" touch.me]}
-
-test cmdAH-20.1 {Tcl_FileObjCmd: atime} {
- list [catch {file atime a b c} msg] $msg
-} {1 {wrong # args: should be "file atime name ?time?"}}
-test cmdAH-20.2 {Tcl_FileObjCmd: atime} {
- catch {unset stat}
- file stat gorp.file stat
- list [expr {[file mtime gorp.file] == $stat(mtime)}] \
- [expr {[file atime gorp.file] == $stat(atime)}]
-} {1 1}
-test cmdAH-20.3 {Tcl_FileObjCmd: atime} {
- string tolower [list [catch {file atime _bogus_} msg] \
- $msg $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-20.4 {Tcl_FileObjCmd: atime} {
- list [catch {file atime $file notint} msg] $msg
-} {1 {expected integer but got "notint"}}
-test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {
- if {[string equal $tcl_platform(platform) "windows"]} {
- set old [pwd]
- cd $::tcltest::temporaryDirectory
- if {![string equal "NTFS" [testvolumetype]]} {
- # Windows FAT doesn't understand atime, but NTFS does
- # May also fail for Windows on NFS mounted disks
- cd $old
- return 1
- }
- cd $old
- }
- set atime [file atime $file]
- after 1100; # pause a sec to notice change in atime
- set newatime [clock seconds]
- expr {$newatime==[file atime $file $newatime]}
-} 1
-
-# isdirectory
-
-test cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} {
- list [catch {file isdirectory a b} msg] $msg
-} {1 {wrong # args: should be "file isdirectory name"}}
-test cmdAH-21.2 {Tcl_FileObjCmd: isdirectory} {
- file isdirectory gorp.file
-} 0
-test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {
- file isd dir.file
-} 1
-
-# isfile
-
-test cmdAH-22.1 {Tcl_FileObjCmd: isfile} {
- list [catch {file isfile a b} msg] $msg
-} {1 {wrong # args: should be "file isfile name"}}
-test cmdAH-22.2 {Tcl_FileObjCmd: isfile} {file isfile gorp.file} 1
-test cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile dir.file} 0
-
-# lstat and readlink: don't run these tests everywhere, since not all
-# sites will have symbolic links
-
-catch {exec ln -s gorp.file link.file}
-test cmdAH-23.1 {Tcl_FileObjCmd: lstat} {
- list [catch {file lstat a} msg] $msg
-} {1 {wrong # args: should be "file lstat name varName"}}
-test cmdAH-23.2 {Tcl_FileObjCmd: lstat} {
- list [catch {file lstat a b c} msg] $msg
-} {1 {wrong # args: should be "file lstat name varName"}}
-test cmdAH-23.3 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {
- catch {unset stat}
- file lstat link.file stat
- lsort [array names stat]
-} {atime ctime dev gid ino mode mtime nlink size type uid}
-test cmdAH-23.4 {Tcl_FileObjCmd: lstat} {unixOnly nonPortable} {
- catch {unset stat}
- file lstat link.file stat
- list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
-} {1 511 link}
-test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
- string tolower [list [catch {file lstat _bogus_ stat} msg] \
- $msg $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} {
- catch {unset x}
- set x 44
- list [catch {file lstat gorp.file x} msg] $msg $errorCode
-} {1 {can't set "x(dev)": variable isn't array} NONE}
-catch {unset stat}
-
-# mkdir
-
-test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} {
- catch {file delete -force a}
- file mkdir a
- set res [file isdirectory a]
- file delete a
- set res
-} {1}
-test cmdAH-23.8 {Tcl_FileObjCmd: mkdir} {
- catch {file delete -force a}
- file mkdir a/b
- set res [file isdirectory a/b]
- file delete -force a
- set res
-} {1}
-test cmdAH-23.9 {Tcl_FileObjCmd: mkdir} {
- catch {file delete -force a}
- file mkdir a/b/c
- set res [file isdirectory a/b/c]
- file delete -force a
- set res
-} {1}
-test cmdAH-23.10 {Tcl_FileObjCmd: mkdir} {
- catch {file delete -force a}
- catch {file delete -force b}
- file mkdir a/b b/a/c
- set res [list [file isdirectory a/b] [file isdirectory b/a/c]]
- file delete -force a
- file delete -force b
- set res
-} {1 1}
-
-# mtime
-
-catch {set file [makeFile "data" touch.me]}
-
-test cmdAH-24.1 {Tcl_FileObjCmd: mtime} {
- list [catch {file mtime a b c} msg] $msg
-} {1 {wrong # args: should be "file mtime name ?time?"}}
-test cmdAH-24.2 {Tcl_FileObjCmd: mtime} {
- set old [file mtime gorp.file]
- after 2000
- set f [open gorp.file w]
- puts $f "More text"
- close $f
- set new [file mtime gorp.file]
- expr {($new > $old) && ($new <= ($old+5))}
-} {1}
-test cmdAH-24.3 {Tcl_FileObjCmd: mtime} {
- catch {unset stat}
- file stat gorp.file stat
- list [expr {[file mtime gorp.file] == $stat(mtime)}] \
- [expr {[file atime gorp.file] == $stat(atime)}]
-} {1 1}
-test cmdAH-24.4 {Tcl_FileObjCmd: mtime} {
- string tolower [list [catch {file mtime _bogus_} msg] $msg \
- $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-24.5 {Tcl_FileObjCmd: mtime} {
- # Under Unix, use a file in /tmp to avoid clock skew due to NFS.
- # On other platforms, just use a file in the local directory.
-
- if {[string equal $tcl_platform(platform) "unix"]} {
- set name /tmp/tcl.test
- } else {
- set name tf
- }
-
- # Make sure that a new file's time is correct. 10 seconds variance
- # is allowed used due to slow networks or clock skew on a network drive.
-
- file delete -force $name
- close [open $name w]
- set a [expr abs([clock seconds]-[file mtime $name])<10]
- file delete $name
- set a
-} {1}
-test cmdAH-24.7 {Tcl_FileObjCmd: mtime} {
- list [catch {file mtime $file notint} msg] $msg
-} {1 {expected integer but got "notint"}}
-test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} {
- set mtime [file mtime $file]
- after 1100; # pause a sec to notice change in mtime
- set newmtime [clock seconds]
- expr {$newmtime==[file mtime $file $newmtime]}
-} 1
-
-
-# owned
-
-test cmdAH-25.1 {Tcl_FileObjCmd: owned} {
- list [catch {file owned a b} msg] $msg
-} {1 {wrong # args: should be "file owned name"}}
-test cmdAH-25.2 {Tcl_FileObjCmd: owned} {
- file owned gorp.file
-} 1
-test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unixOnly notRoot} {
- file owned /
-} 0
-
-# readlink
-
-test cmdAH-26.1 {Tcl_FileObjCmd: readlink} {
- list [catch {file readlink a b} msg] $msg
-} {1 {wrong # args: should be "file readlink name"}}
-test cmdAH-26.2 {Tcl_FileObjCmd: readlink} {unixOnly nonPortable} {
- file readlink link.file
-} gorp.file
-test cmdAH-26.3 {Tcl_FileObjCmd: readlink errors} {unixOnly nonPortable} {
- list [catch {file readlink _bogus_} msg] [string tolower $msg] \
- [string tolower $errorCode]
-} {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-26.4 {Tcl_FileObjCmd: readlink errors} {macOnly nonPortable} {
- list [catch {file readlink _bogus_} msg] [string tolower $msg] \
- [string tolower $errorCode]
-} {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {pcOnly nonPortable} {
- list [catch {file readlink _bogus_} msg] [string tolower $msg] \
- [string tolower $errorCode]
-} {1 {could not readlink "_bogus_": invalid argument} {posix einval {invalid argument}}}
-
-# size
-
-test cmdAH-27.1 {Tcl_FileObjCmd: size} {
- list [catch {file size a b} msg] $msg
-} {1 {wrong # args: should be "file size name"}}
-test cmdAH-27.2 {Tcl_FileObjCmd: size} {
- set oldsize [file size gorp.file]
- set f [open gorp.file a]
- fconfigure $f -translation lf -eofchar {}
- puts $f "More text"
- close $f
- expr {[file size gorp.file] - $oldsize}
-} {10}
-test cmdAH-27.3 {Tcl_FileObjCmd: size} {
- string tolower [list [catch {file size _bogus_} msg] $msg \
- $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-
-# stat
-
-catch {testsetplatform $platform}
-catch {makeFile "Test string" gorp.file}
-catch {exec chmod 765 gorp.file}
-
-test cmdAH-28.1 {Tcl_FileObjCmd: stat} {
- list [catch {file stat _bogus_} msg] $msg $errorCode
-} {1 {wrong # args: should be "file stat name varName"} NONE}
-test cmdAH-28.2 {Tcl_FileObjCmd: stat} {
- list [catch {file stat _bogus_ a b} msg] $msg $errorCode
-} {1 {wrong # args: should be "file stat name varName"} NONE}
-test cmdAH-28.3 {Tcl_FileObjCmd: stat} {
- catch {unset stat}
- file stat gorp.file stat
- lsort [array names stat]
-} {atime ctime dev gid ino mode mtime nlink size type uid}
-test cmdAH-28.4 {Tcl_FileObjCmd: stat} {
- catch {unset stat}
- file stat gorp.file stat
- list $stat(nlink) $stat(size) $stat(type)
-} {1 12 file}
-test cmdAH-28.5 {Tcl_FileObjCmd: stat} {unixOnly} {
- catch {unset stat}
- file stat gorp.file stat
- expr $stat(mode)&0777
-} {501}
-test cmdAH-28.6 {Tcl_FileObjCmd: stat} {
- string tolower [list [catch {file stat _bogus_ stat} msg] \
- $msg $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-28.7 {Tcl_FileObjCmd: stat} {
- catch {unset x}
- set x 44
- list [catch {file stat gorp.file x} msg] $msg $errorCode
-} {1 {can't set "x(dev)": variable isn't array} NONE}
-test cmdAH-28.8 {Tcl_FileObjCmd: stat} {
- # Sign extension of purported unsigned short to int.
-
- close [open foo.test w]
- file stat foo.test stat
- set x [expr {$stat(mode) > 0}]
- file delete foo.test
- set x
-} 1
-test cmdAH-28.9 {Tcl_FileObjCmd: stat} {pcOnly} {
- # stat of root directory was failing.
- # don't care about answer, just that test runs.
-
- # relative paths that resolve to root
- set old [pwd]
- cd c:/
- file stat c: stat
- file stat c:. stat
- file stat . stat
- cd $old
-
- file stat / stat
- file stat c:/ stat
- file stat c:/. stat
-} {}
-test cmdAH-28.10 {Tcl_FileObjCmd: stat} {pcOnly nonPortable} {
- # stat of root directory was failing.
- # don't care about answer, just that test runs.
-
- file stat //pop/$env(USERNAME) stat
- file stat //pop/$env(USERNAME)/ stat
- file stat //pop/$env(USERNAME)/. stat
-} {}
-test cmdAH-28.11 {Tcl_FileObjCmd: stat} {pcOnly nonPortable} {
- # stat of network directory was returning id of current local drive.
-
- set old [pwd]
- cd c:/
-
- file stat //pop/$env(USERNAME) stat
- cd $old
- expr {$stat(dev) == 2}
-} 0
-test cmdAH-28.12 {Tcl_FileObjCmd: stat} {
- # stat(mode) with S_IFREG flag was returned as a negative number
- # if mode_t was a short instead of an unsigned short.
-
- close [open foo.test w]
- file stat foo.test stat
- file delete foo.test
- expr {$stat(mode) > 0}
-} 1
-catch {unset stat}
-
-# type
-
-file delete link.file
-
-test cmdAH-29.1 {Tcl_FileObjCmd: type} {
- list [catch {file size a b} msg] $msg
-} {1 {wrong # args: should be "file size name"}}
-test cmdAH-29.2 {Tcl_FileObjCmd: type} {
- file type dir.file
-} directory
-test cmdAH-29.3 {Tcl_FileObjCmd: type} {
- file type gorp.file
-} file
-test cmdAH-29.4 {Tcl_FileObjCmd: type} {unixOnly nonPortable} {
- exec ln -s a/b/c link.file
- set result [file type link.file]
- file delete link.file
- set result
-} link
-test cmdAH-29.5 {Tcl_FileObjCmd: type} {
- string tolower [list [catch {file type _bogus_} msg] $msg $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-
-# Error conditions
-
-test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} {
- list [catch {file gorp x} msg] $msg
-} {1 {bad option "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
-test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} {
- list [catch {file ex x} msg] $msg
-} {1 {ambiguous option "ex": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
-test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} {
- list [catch {file is x} msg] $msg
-} {1 {ambiguous option "is": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
-test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} {
- list [catch {file z x} msg] $msg
-} {1 {bad option "z": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
-test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} {
- list [catch {file read x} msg] $msg
-} {1 {ambiguous option "read": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
-test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} {
- list [catch {file s x} msg] $msg
-} {1 {ambiguous option "s": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
-test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} {
- list [catch {file t x} msg] $msg
-} {1 {ambiguous option "t": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
-test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} {
- list [catch {file dirname ~woohgy} msg] $msg
-} {1 {user "woohgy" doesn't exist}}
-
-# channels
-# In testing 'file channels', we need to make sure that a channel
-# created in one interp isn't visible in another.
-
-interp create simpleInterp
-interp create -safe safeInterp
-interp c
-safeInterp expose file file
-
-test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} {
- list [catch {file channels a b} msg] $msg
-} {1 {wrong # args: should be "file channels ?pattern?"}}
-test cmdAH-31.2 {Tcl_FileObjCmd: channels, too many args} {
- # Normal interps start out with only the standard channels
- lsort [simpleInterp eval [list file chan]]
-} [lsort {stderr stdout stdin}]
-test cmdAH-31.3 {Tcl_FileObjCmd: channels, globbing} {
- string equal [file channels] [file channels *]
-} {1}
-test cmdAH-31.4 {Tcl_FileObjCmd: channels, globbing} {
- lsort [file channels std*]
-} [lsort {stdout stderr stdin}]
-
-set newFileId ""
-
-test cmdAH-31.5.0 {Tcl_FileObjCmd: channels} {fsIsWritable} {
- catch {set newFileId [open gorp.file w]}
-} {0}
-
-test cmdAH-31.5 {Tcl_FileObjCmd: channels} {fsIsWritable} {
- set res [file channels $newFileId]
- string equal $newFileId $res
-} {1}
-test cmdAH-31.6 {Tcl_FileObjCmd: channels in other interp} {
- # Safe interps start out with no channels
- safeInterp eval [list file channels]
-} {}
-test cmdAH-31.7 {Tcl_FileObjCmd: channels in other interp} {fsIsWritable} {
- list [catch {safeInterp eval [list puts $newFileId "hello"]} msg] $msg
-} [list 1 "can not find channel named \"$newFileId\""]
-
-catch {
- interp share {} $newFileId safeInterp
-}
-interp share {} stdout safeInterp
-
-test cmdAH-31.8 {Tcl_FileObjCmd: channels in other interp} {fsIsWritable} {
- # $newFileId should now be visible in both interps
- list [file channels $newFileId] \
- [safeInterp eval [list file channels $newFileId]]
-} [list $newFileId $newFileId]
-test cmdAH-31.9 {Tcl_FileObjCmd: channels in other interp} {fsIsWritable} {
- lsort [safeInterp eval [list file channels]]
-} [lsort [list stdout $newFileId]]
-test cmdAH-31.10 {Tcl_FileObjCmd: channels in other interp} {fsIsWritable} {
- # we can now write to $newFileId from slave
- safeInterp eval [list puts $newFileId "hello"]
-} {}
-
-catch {
- interp transfer {} $newFileId safeInterp
-}
-
-test cmdAH-31.11 {Tcl_FileObjCmd: channels in other interp} {fsIsWritable} {
- # $newFileId should now be visible only in safeInterp
- list [file channels $newFileId] \
- [safeInterp eval [list file channels $newFileId]]
-} [list {} $newFileId]
-test cmdAH-31.12 {Tcl_FileObjCmd: channels in other interp} {fsIsWritable} {
- lsort [safeInterp eval [list file channels]]
-} [lsort [list stdout $newFileId]]
-test cmdAH-31.13 {Tcl_FileObjCmd: channels in other interp} {fsIsWritable} {
- safeInterp eval [list close $newFileId]
- safeInterp eval [list file channels]
-} {stdout}
-
-# This shouldn't work, but just in case a test above failed...
-catch {close $newFileId}
-
-interp delete safeInterp
-interp delete simpleInterp
-
-# cleanup
-catch {testsetplatform $platform}
-catch {unset platform}
-
-# Tcl_ForObjCmd is tested in for.test
-
-catch {exec chmod 777 dir.file}
-catch {
- file delete -force dir.file
- file delete gorp.file
- file delete link.file
-}
-
-cd $cmdAHwd
-
-::tcltest::cleanupTests
-return
-
-
-
-
-
-
-
-
-
-
-
-
-
+++ /dev/null
-# This file contains a collection of tests for tclEncoding.c\r# Sourcing this file into Tcl runs the tests and generates output for\r# errors. No output means no errors were found.\r#\r# Copyright (c) 1997 Sun Microsystems, Inc.\r# Copyright (c) 1998-1999 by Scriptics Corporation.\r#\r# See the file "license.terms" for information on usage and redistribution\r# of this file, and for a DISCLAIMER OF ALL WARRANTIES.\r#\r# RCS: @(#) $Id$\r\rif {[lsearch [namespace children] ::tcltest] == -1} {\r package require tcltest\r namespace import -force ::tcltest::*\r}\r\rproc toutf {args} {\r global x\r lappend x "toutf $args"\r}\rproc fromutf {args} {\r global x\r lappend x "fromutf $args"\r}\r\r# Some tests require the testencoding command\r\rset ::tcltest::testConstraints(testencoding) \\r [expr {[info commands testencoding] != {}}]\r\r\r# TclInitEncodingSubsystem is tested by the rest of this file\r# TclFinalizeEncodingSubsystem is not currently tested\r\rtest encoding-1.1 {Tcl_GetEncoding: system encoding} {testencoding} {\r testencoding create foo toutf fromutf\r set old [encoding system]\r encoding system foo\r set x {}\r encoding convertto abcd\r encoding system $old\r testencoding delete foo\r set x\r} {{fromutf }}\rtest encoding-1.2 {Tcl_GetEncoding: existing encoding} {testencoding} {\r testencoding create foo toutf fromutf\r set x {}\r encoding convertto foo abcd\r testencoding delete foo\r set x\r} {{fromutf }}\rtest encoding-1.3 {Tcl_GetEncoding: load encoding} {\r list [encoding convertto jis0208 \u4e4e] \\r [encoding convertfrom jis0208 8C]\r} "8C \u4e4e"\r\rtest encoding-2.1 {Tcl_FreeEncoding: refcount == 0} {\r encoding convertto jis0208 \u4e4e\r} {8C}\rtest encoding-2.2 {Tcl_FreeEncoding: refcount != 0} {testencoding} {\r set system [encoding system]\r set path [testencoding path]\r encoding system shiftjis ;# incr ref count\r testencoding path [list [pwd]]\r set x [encoding convertto shiftjis \u4e4e] ;# old one found \r encoding system identity\r lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg\r encoding system identity\r testencoding path $path\r encoding system $system\r set x\r} "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"\r\rtest encoding-3.1 {Tcl_GetEncodingName, NULL} {\r set old [encoding system]\r encoding system shiftjis\r set x [encoding system]\r encoding system $old\r set x\r} {shiftjis}\rtest encoding-3.2 {Tcl_GetEncodingName, non-null} {\r set old [fconfigure stdout -encoding]\r fconfigure stdout -encoding jis0208\r set x [fconfigure stdout -encoding]\r fconfigure stdout -encoding $old\r set x\r} {jis0208}\r\rtest encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {\r file mkdir tmp/encoding\r close [open tmp/encoding/junk.enc w]\r close [open tmp/encoding/junk2.enc w]\r cd tmp\r set path [testencoding path]\r testencoding path {}\r catch {unset encodings}\r catch {unset x}\r foreach encoding [encoding names] {\r set encodings($encoding) 1\r }\r testencoding path [list [pwd]]\r foreach encoding [encoding names] {\r if {![info exists encodings($encoding)]} {\r lappend x $encoding\r }\r }\r testencoding path $path\r cd ..\r file delete -force tmp\r lsort $x\r} {junk junk2}\r\rtest encoding-5.1 {Tcl_SetSystemEncoding} {\r set old [encoding system]\r encoding system jis0208\r set x [encoding convertto \u4e4e]\r encoding system identity\r encoding system $old\r set x\r} {8C}\rtest encoding-5.2 {Tcl_SetSystemEncoding: test ref count} {\r set old [encoding system]\r encoding system $old\r string compare $old [encoding system]\r} {0}\r\rtest encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} {\r testencoding create foo {toutf 1} {fromutf 2}\r set x {}\r encoding convertfrom foo abcd\r encoding convertto foo abcd\r testencoding delete foo\r set x\r} {{toutf 1} {fromutf 2}}\rtest encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} {\r testencoding create foo {toutf a} {fromutf b}\r set x {}\r encoding convertfrom foo abcd\r encoding convertto foo abcd\r testencoding delete foo\r set x\r} {{toutf a} {fromutf b}}\r\rtest encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} {\r encoding convertfrom jis0208 8c8c8c8c\r} "\u543e\u543e\u543e\u543e"\rtest encoding-7.2 {Tcl_UtfToExternalDString: big buffer} {\r set a 8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C\r append a $a\r append a $a\r append a $a\r append a $a\r set x [encoding convertfrom jis0208 $a]\r list [string length $x] [string index $x 0]\r} "512 \u4e4e"\r\rtest encoding-8.1 {Tcl_ExternalToUtf} {fsIsWritable} {\r set f [open dummy w]\r fconfigure $f -translation binary -encoding iso8859-1\r puts -nonewline $f "ab\x8c\xc1g"\r close $f\r set f [open dummy r]\r fconfigure $f -translation binary -encoding shiftjis \r set x [read $f]\r close $f\r file delete dummy\r set x\r} "ab\u4e4eg"\r\rtest encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {\r encoding convertto jis0208 "\u543e\u543e\u543e\u543e"\r} {8c8c8c8c}\rtest encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {\r set a \u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\r append a $a\r append a $a\r append a $a\r append a $a\r append a $a\r append a $a\r set x [encoding convertto jis0208 $a]\r list [string length $x] [string range $x 0 1]\r} "1024 8C"\r\rtest encoding-10.1 {Tcl_UtfToExternal} {fsIsWritable} {\r set f [open dummy w]\r fconfigure $f -translation binary -encoding shiftjis\r puts -nonewline $f "ab\u4e4eg"\r close $f\r set f [open dummy r]\r fconfigure $f -translation binary -encoding iso8859-1\r set x [read $f]\r close $f\r file delete dummy\r set x\r} "ab\x8c\xc1g"\r\rtest encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {\r set system [encoding system]\r set path [testencoding path]\r encoding system iso8859-1\r testencoding path {}\r set x [list [catch {encoding convertto jis0208 \u4e4e} msg] $msg]\r testencoding path $path\r encoding system $system\r lappend x [encoding convertto jis0208 \u4e4e]\r} {1 {unknown encoding "jis0208"} 8C}\rtest encoding-11.2 {LoadEncodingFile: single-byte} {\r encoding convertfrom jis0201 \xa1\r} "\uff61"\rtest encoding-11.3 {LoadEncodingFile: double-byte} {\r encoding convertfrom jis0208 8C\r} "\u4e4e"\rtest encoding-11.4 {LoadEncodingFile: multi-byte} {\r encoding convertfrom shiftjis \x8c\xc1\r} "\u4e4e"\rtest encoding-11.5 {LoadEncodingFile: escape file} {\r encoding convertto iso2022 \u4e4e\r} "\x1b(B\x1b$@8C"\rtest encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} {\r set system [encoding system]\r set path [testencoding path]\r encoding system identity\r testencoding path tmp\r file mkdir tmp/encoding\r set f [open tmp/encoding/splat.enc w]\r fconfigure $f -translation binary \r puts $f "abcdefghijklmnop"\r close $f\r set x [list [catch {encoding convertto splat \u4e4e} msg] $msg]\r file delete -force tmp\r catch {file delete encoding}\r testencoding path $path\r encoding system $system\r set x\r} {1 {invalid encoding file "splat"}}\r\r# OpenEncodingFile is fully tested by the rest of the tests in this file.\r\rtest encoding-12.1 {LoadTableEncoding: normal encoding} {\r set x [encoding convertto iso8859-3 \u120]\r append x [encoding convertto iso8859-3 \ud5]\r append x [encoding convertfrom iso8859-3 \xd5]\r} "\xd5?\u120"\rtest encoding-12.2 {LoadTableEncoding: single-byte encoding} {\r set x [encoding convertto iso8859-3 ab\u0120g] \r append x [encoding convertfrom iso8859-3 ab\xd5g]\r} "ab\xd5gab\u120g"\rtest encoding-12.3 {LoadTableEncoding: multi-byte encoding} {\r set x [encoding convertto shiftjis ab\u4e4eg] \r append x [encoding convertfrom shiftjis ab\x8c\xc1g]\r} "ab\x8c\xc1gab\u4e4eg"\rtest encoding-12.4 {LoadTableEncoding: double-byte encoding} {\r set x [encoding convertto jis0208 \u4e4e\u3b1]\r append x [encoding convertfrom jis0208 8C&A]\r} "8C&A\u4e4e\u3b1"\rtest encoding-12.5 {LoadTableEncoding: symbol encoding} {\r set x [encoding convertto symbol \u3b3]\r append x [encoding convertto symbol \u67]\r append x [encoding convertfrom symbol \x67]\r} "\x67\x67\u3b3"\r\rtest encoding-13.1 {LoadEscapeTable} {\r set x [encoding convertto iso2022 ab\u4e4e\u68d9g]\r} "\x1b(Bab\x1b$@8C\x1b$\(DD%\x1b(Bg"\r\rtest encoding-14.1 {BinaryProc} {\r encoding convertto identity \x12\x34\x56\xff\x69\r} "\x12\x34\x56\xc3\xbf\x69"\r\rtest encoding-15.1 {UtfToUtfProc} {\r encoding convertto utf-8 \xa3\r} "\xc2\xa3"\r\rtest encoding-16.1 {UnicodeToUtfProc} {\r encoding convertfrom unicode NN\r} "\u4e4e"\r\rtest encoding-17.1 {UtfToUnicodeProc} {\r} {}\r\rtest encoding-18.1 {TableToUtfProc} {\r} {}\r\rtest encoding-19.1 {TableFromUtfProc} {\r} {}\r\rtest encoding-20.1 {TableFreefProc} {\r} {}\r\rtest encoding-21.1 {EscapeToUtfProc} {\r} {}\r\rtest encoding-22.1 {EscapeFromUtfProc} {\r} {}\r\r# EscapeFreeProc, GetTableEncoding, unilen\r# are fully tested by the rest of this file\r\r# cleanup\r::tcltest::cleanupTests\rreturn\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r
\ No newline at end of file
+++ /dev/null
-# This file tests the tclFCmd.c file.
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
-#
-# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-# Copyright (c) 1999 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id$
-#
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]]
-tcltest::testConstraint testchmod [string equal testchmod [info commands testchmod]]
-tcltest::testConstraint fsIsWritable [expr {1 - [catch {file mkdir isreadonly ; file delete isreadonly}]}]
-
-# Several tests require need to match results against the unix username
-set user {}
-if {$tcl_platform(platform) == "unix"} {
- catch {set user [exec whoami]}
- if {$user == ""} {
- catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
- }
- if {$user == ""} {
- set user "root"
- }
-}
-
-proc createfile {file {string a}} {
- set f [open $file w]
- puts -nonewline $f $string
- close $f
- return $string
-}
-
-#
-# checkcontent --
-#
-# Ensures that file "file" contains only the string "matchString"
-# returns 0 if the file does not exist, or has a different content
-#
-proc checkcontent {file matchString} {
- if {[catch {
- set f [open $file]
- set fileString [read $f]
- close $f
- }]} {
- return 0
- }
- return [string match $matchString $fileString]
-}
-
-proc openup {path} {
- testchmod 777 $path
- if {[file isdirectory $path]} {
- catch {
- foreach p [glob -directory $path *] {
- openup $p
- }
- }
- }
-}
-
-proc cleanup {args} {
- foreach p [concat [list .] $args] {
- set x ""
- catch {
- set x [glob -directory $p tf* td*]
- }
- foreach file $x {
- if {[catch {file delete -force -- $file}]} {
- catch {openup $file}
- catch {file delete -force -- $file}
- }
- }
- }
-}
-
-proc contents {file} {
- set f [open $file r]
- set r [read $f]
- close $f
- set r
-}
-
-set ::tcltest::testConstraints(fileSharing) 0
-set ::tcltest::testConstraints(notFileSharing) 1
-
-if {$tcl_platform(platform) == "macintosh"} {
- catch {file delete -force foo.dir}
- file mkdir foo.dir
- if {[catch {file attributes foo.dir -readonly 1}] == 0} {
- set ::tcltest::testConstraints(fileSharing) 1
- set ::tcltest::testConstraints(notFileSharing) 0
- }
- file delete -force foo.dir
-}
-
-set ::tcltest::testConstraints(xdev) 0
-
-if {$tcl_platform(platform) == "unix"} {
- if {[catch {set m1 [exec df .]; set m2 [exec df /tmp]}] == 0} {
- set m1 [string range $m1 0 [expr [string first " " $m1]-1]]
- set m2 [string range $m2 0 [expr [string first " " $m2]-1]]
- if {$m1 != "" && $m2 != "" && $m1 != $m2 && [file exists $m1] && [file exists $m2]} {
- set ::tcltest::testConstraints(xdev) 1
- }
- }
-}
-
-set root [lindex [file split [pwd]] 0]
-
-# A really long file name
-# length of long is 1216 chars, which should be greater than any static
-# buffer or allowable filename.
-
-set long "abcdefghihjllmnopqrstuvwxyz01234567890"
-append long $long
-append long $long
-append long $long
-append long $long
-append long $long
-
-test fCmd-1.1 {TclFileRenameCmd} {notRoot fsIsWritable} {
- cleanup
- createfile tf1
- file rename tf1 tf2
- glob tf*
-} {tf2}
-
-test fCmd-2.1 {TclFileCopyCmd} {notRoot fsIsWritable} {
- cleanup
- createfile tf1
- file copy tf1 tf2
- lsort [glob tf*]
-} {tf1 tf2}
-
-test fCmd-3.1 {FileCopyRename: FileForceOption fails} {notRoot} {
- list [catch {file rename -xyz} msg] $msg
-} {1 {bad option "-xyz": should be -force or --}}
-test fCmd-3.2 {FileCopyRename: not enough args} {notRoot} {
- list [catch {file rename xyz} msg] $msg
-} {1 {wrong # args: should be "file rename ?options? source ?source ...? target"}}
-test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} {notRoot} {
- list [catch {file rename xyz ~_totally_bogus_user} msg] $msg
-} {1 {user "_totally_bogus_user" doesn't exist}}
-test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} {notRoot} {
- cleanup
- list [catch {file copy tf1 ~} msg] $msg
-} {1 {error copying "tf1": no such file or directory}}
-test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} {notRoot} {
- cleanup
- list [catch {file rename tf1 tf2 tf3} msg] $msg
-} {1 {error renaming: target "tf3" is not a directory}}
-test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} \
- {notRoot fsIsWritable} {
- cleanup
- createfile tf3
- list [catch {file rename tf1 tf2 tf3} msg] $msg
-} {1 {error renaming: target "tf3" is not a directory}}
-test fCmd-3.7 {FileCopyRename: target exists & is directory} \
- {notRoot fsIsWritable} {
- cleanup
- file mkdir td1
- createfile tf1 tf1
- file rename tf1 td1
- contents [file join td1 tf1]
-} {tf1}
-test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {
- cleanup
- list [catch {file rename tf1 tf2 tf3} msg] $msg
-} {1 {error renaming: target "tf3" is not a directory}}
-test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {
- cleanup
- list [catch {file copy -force -- tf1 tf2 tf3} msg] $msg
-} {1 {error copying: target "tf3" is not a directory}}
-test fCmd-3.10 {FileCopyRename: just 2 arguments} {notRoot fsIsWritable} {
- cleanup
- createfile tf1 tf1
- file rename tf1 tf2
- contents tf2
-} {tf1}
-test fCmd-3.11 {FileCopyRename: just 2 arguments} {notRoot fsIsWritable} {
- cleanup
- createfile tf1 tf1
- file rename -force -force -- tf1 tf2
- contents tf2
-} {tf1}
-test fCmd-3.12 {FileCopyRename: move each source: 1 source} \
- {notRoot fsIsWritable} {
- cleanup
- createfile tf1 tf1
- file mkdir td1
- file rename tf1 td1
- contents [file join td1 tf1]
-} {tf1}
-test fCmd-3.13 {FileCopyRename: move each source: multiple sources} \
- {notRoot fsIsWritable} {
- cleanup
- createfile tf1 tf1
- createfile tf2 tf2
- createfile tf3 tf3
- createfile tf4 tf4
- file mkdir td1
- file rename tf1 tf2 tf3 tf4 td1
- list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \
- [contents [file join td1 tf3]] [contents [file join td1 tf4]]
-} {tf1 tf2 tf3 tf4}
-test fCmd-3.14 {FileCopyRename: FileBasename fails} {notRoot fsIsWritable} {
- cleanup
- file mkdir td1
- list [catch {file rename ~_totally_bogus_user td1} msg] $msg
-} {1 {user "_totally_bogus_user" doesn't exist}}
-test fCmd-3.15 {FileCopyRename: source[0] == '\0'} \
- {notRoot unixOrPc fsIsWritable} {
- cleanup
- file mkdir td1
- list [catch {file rename / td1} msg] $msg
-} {1 {error renaming "/" to "td1": file already exists}}
-test fCmd-3.16 {FileCopyRename: break on first error} {notRoot fsIsWritable} {
- cleanup
- createfile tf1
- createfile tf2
- createfile tf3
- createfile tf4
- file mkdir td1
- createfile [file join td1 tf3]
- list [catch {file rename tf1 tf2 tf3 tf4 td1} msg] $msg
-} [subst {1 {error renaming "tf3" to "[file join td1 tf3]": file already exists}}]
-
-test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} \
- {notRoot fsIsWritable} {
- cleanup
- file mkdir td1
- glob td*
-} {td1}
-test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} \
- {notRoot fsIsWritable} {
- cleanup
- file mkdir td1 td2 td3
- lsort [glob td*]
-} {td1 td2 td3}
-test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} \
- {notRoot fsIsWritable} {
- cleanup
- createfile tf1
- catch {file mkdir td1 td2 tf1 td3 td4}
- glob td1 td2 tf1 td3 td4
-} {td1 td2 tf1}
-test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} {notRoot} {
- cleanup
- list [catch {file mkdir ~_totally_bogus_user} msg] $msg
-} {1 {user "_totally_bogus_user" doesn't exist}}
-test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} \
- {notRoot} {
- cleanup
- list [catch {file mkdir ""} msg] $msg
-} {1 {can't create directory "": no such file or directory}}
-test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {notRoot fsIsWritable} {
- cleanup
- file mkdir td1
- glob td1
-} {td1}
-test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {notRoot fsIsWritable} {
- cleanup
- file mkdir [file join td1 td2 td3 td4]
- glob td1 [file join td1 td2]
-} "td1 [file join td1 td2]"
-test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {notRoot} {
- cleanup
- file mkdir td1
- set x [file exist td1]
- file mkdir td1
- list $x [file exist td1]
-} {1 1}
-test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} {notRoot} {
- cleanup
- createfile tf1
- list [catch {file mkdir tf1} msg] $msg
-} [subst {1 {can't create directory "[file join tf1]": file already exists}}]
-test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} {
- cleanup
- file mkdir td1
- set x [file exist td1]
- file mkdir td1
- list $x [file exist td1]
-} {1 1}
-test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} \
- {unixOnly notRoot testchmod} {
- cleanup
- file mkdir td1/td2/td3
- testchmod 000 td1/td2
- set msg [list [catch {file mkdir td1/td2/td3/td4} msg] $msg]
- testchmod 755 td1/td2
- set msg
-} {1 {can't create directory "td1/td2/td3": permission denied}}
-test fCmd-4.12 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} {macOnly} {
- cleanup
- list [catch {file mkdir nonexistentvolume:} msg] $msg
-} {1 {can't create directory "nonexistentvolume:": invalid argument}}
-test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {notRoot} {
- cleanup
- set x [file exist td1]
- file mkdir td1
- list $x [file exist td1]
-} {0 1}
-test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} \
- {unixOnly notRoot} {
- cleanup
- file delete -force foo
- file mkdir foo
- file attr foo -perm 040000
- set result [list [catch {file mkdir foo/tf1} msg] $msg]
- file delete -force foo
- set result
-} {1 {can't create directory "foo/tf1": permission denied}}
-test fCmd-4.15 {TclFileMakeDirsCmd: TclpCreateDirectory fails} {macOnly} {
- list [catch {file mkdir ${root}:} msg] $msg
-} [subst {1 {can't create directory "${root}:": no such file or directory}}]
-test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {notRoot} {
- cleanup
- file mkdir tf1
- file exists tf1
-} {1}
-
-test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} {notRoot} {
- list [catch {file delete -xyz} msg] $msg
-} {1 {bad option "-xyz": should be -force or --}}
-test fCmd-5.2 {TclFileDeleteCmd: not enough args} {notRoot} {
- list [catch {file delete -force -force} msg] $msg
-} {1 {wrong # args: should be "file delete ?options? file ?file ...?"}}
-test fCmd-5.3 {TclFileDeleteCmd: 1 file} {notRoot} {
- cleanup
- createfile tf1
- createfile tf2
- file mkdir td1
- file delete tf2
- glob tf* td*
-} {tf1 td1}
-test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} {
- cleanup
- createfile tf1
- createfile tf2
- file mkdir td1
- set x [list [file exist tf1] [file exist tf2] [file exist td1]]
- file delete tf1 td1 tf2
- lappend x [file exist tf1] [file exist tf2] [file exist tf3]
-} {1 1 1 0 0 0}
-test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrPc} {
- cleanup
- createfile tf1
- createfile tf2
- file mkdir td1
- catch {file delete tf1 td1 $root tf2}
- list [file exist tf1] [file exist tf2] [file exist td1]
-} {0 1 0}
-test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} {notRoot} {
- list [catch {file delete ~_totally_bogus_user} msg] $msg
-} {1 {user "_totally_bogus_user" doesn't exist}}
-test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {notRoot} {
- catch {file delete ~/tf1}
- createfile ~/tf1
- file delete ~/tf1
-} {}
-test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot} {
- cleanup
- set x [file exist tf1]
- file delete tf1
- list $x [file exist tf1]
-} {0 0}
-test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} {
- cleanup
- file mkdir td1
- file delete td1
- file exist td1
-} {0}
-test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} {notRoot} {
- cleanup
- file mkdir td1/td2
- list [catch {file delete td1} msg] $msg
-} {1 {error deleting "td1": directory not empty}}
-
-test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot} {
- # can't test this, because it's caught by FileCopyRename
-} {}
-test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot} {
- # can't test this, because it's caught by FileCopyRename
-} {}
-test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} {notRoot} {
- cleanup
- list [catch {file rename tf1 tf2} msg] $msg
-} {1 {error renaming "tf1": no such file or directory}}
-test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {notRoot} {
- cleanup
- createfile tf1
- file rename tf1 tf2
- glob tf*
-} {tf2}
-test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} {
- cleanup
- createfile tf1
- file rename tf1 tf2
- glob tf*
-} {tf2}
-test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unixOnly notRoot testchmod} {
- cleanup
- file mkdir td1
- testchmod 000 td1
- createfile tf1
- set msg [list [catch {file rename tf1 td1} msg] $msg]
- testchmod 755 td1
- set msg
-} {1 {error renaming "tf1" to "td1/tf1": permission denied}}
-test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} {95} {
- cleanup
- createfile tf1
- list [catch {file rename tf1 $long} msg] $msg
-} [subst {1 {error renaming "tf1" to "$long": file name too long}}]
-test fCmd-6.8 {CopyRenameOneFile: errno != ENOENT} {macOnly} {
- cleanup
- createfile tf1
- list [catch {file rename tf1 $long} msg] $msg
-} [subst {1 {error renaming "tf1" to "$long": file name too long}}]
-test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unixOnly notRoot} {
- cleanup
- createfile tf1
- file rename tf1 tf2
- glob tf*
-} {tf2}
-test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} {notRoot} {
- cleanup
- createfile tf1
- createfile tf2
- list [catch {file rename tf1 tf2} msg] $msg
-} {1 {error renaming "tf1" to "tf2": file already exists}}
-test fCmd-6.11 {CopyRenameOneFile: force == 0} {notRoot} {
- cleanup
- createfile tf1
- createfile tf2
- list [catch {file rename tf1 tf2} msg] $msg
-} {1 {error renaming "tf1" to "tf2": file already exists}}
-test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} {
- cleanup
- createfile tf1
- createfile tf2
- file rename -force tf1 tf2
- glob tf*
-} {tf2}
-test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} {notRoot} {
- cleanup
- file mkdir td1
- file mkdir td2
- createfile [file join td2 td1]
- list [catch {file rename -force td1 td2} msg] $msg
-} [subst {1 {can't overwrite file "[file join td2 td1]" with directory "td1"}}]
-test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} {notRoot} {
- cleanup
- createfile tf1
- file mkdir [file join td1 tf1]
- list [catch {file rename -force tf1 td1} msg] $msg
-} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
-test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} {notRoot} {
- cleanup
- file mkdir [file join td1 td2]
- file mkdir td2
- createfile [file join td2 tf1]
- file rename -force td2 td1
- file exists [file join td1 td2 tf1]
-} {1}
-test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} {notRoot} {
- cleanup
- file mkdir [file join td1 td2]
- createfile [file join td1 td2 tf1]
- file mkdir td2
- list [catch {file rename -force td2 td1} msg] $msg
-} [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]
-
-test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} {notRoot} {
- cleanup
- list [catch {file rename -force $root tf1} msg] $msg
-} [subst {1 {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}}]
-test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} {notRoot} {
- cleanup
- file mkdir [file join td1 td2]
- createfile [file join td1 td2 tf1]
- file mkdir td2
- list [catch {file rename -force td2 td1} msg] $msg
-} [subst {1 {error renaming "td2" to "[file join td1 td2]": file already exists}}]
-test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unixOnly notRoot} {
- cleanup /tmp
- createfile tf1
- file rename tf1 /tmp
- glob tf* /tmp/tf1
-} {/tmp/tf1}
-test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {pcOnly} {
- catch {file delete -force c:/tcl8975@ d:/tcl8975@}
- file mkdir c:/tcl8975@
- if [catch {file rename c:/tcl8975@ d:/}] {
- set msg d:/tcl8975@
- } else {
- set msg [glob c:/tcl8975@ d:/tcl8975@]
- file delete -force d:/tcl8975@
- }
- file delete -force c:/tcl8975@
- set msg
-} {d:/tcl8975@}
-test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \
- {unixOnly notRoot} {
- cleanup /tmp
- file mkdir td1
- file rename td1 /tmp
- glob td* /tmp/td*
-} {/tmp/td1}
-test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \
- {unixOnly notRoot} {
- cleanup /tmp
- createfile tf1
- file rename tf1 /tmp
- glob tf* /tmp/tf*
-} {/tmp/tf1}
-test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} \
- {unixOnly notRoot xdev} {
- cleanup /tmp
- file mkdir td1/td2/td3
- exec chmod 000 td1
- set msg [list [catch {file rename td1 /tmp} msg] $msg]
- exec chmod 755 td1
- set msg
-} {1 {error renaming "td1": permission denied}}
-test fCmd-6.24 {CopyRenameOneFile: error uses original name} \
- {unixOnly notRoot} {
- cleanup
- file mkdir ~/td1/td2
- exec chmod 000 [file join [file dirname ~] [file tail ~] td1]
- set msg [list [catch {file copy ~/td1 td1} msg] $msg]
- exec chmod 755 [file join [file dirname ~] [file tail ~] td1]
- file delete -force ~/td1
- set msg
-} {1 {error copying "~/td1": permission denied}}
-test fCmd-6.25 {CopyRenameOneFile: error uses original name} \
- {unixOnly notRoot} {
- cleanup
- file mkdir td2
- file mkdir ~/td1
- exec chmod 000 [file join [file dirname ~] [file tail ~] td1]
- set msg [list [catch {file copy td2 ~/td1} msg] $msg]
- exec chmod 755 [file join [file dirname ~] [file tail ~] td1]
- file delete -force ~/td1
- set msg
-} {1 {error copying "td2" to "~/td1/td2": permission denied}}
-test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} \
- {unixOnly notRoot} {
- cleanup
- file mkdir ~/td1/td2
- exec chmod 000 [file join [file dirname ~] [file tail ~] td1 td2]
- set msg [list [catch {file copy ~/td1 td1} msg] $msg]
- exec chmod 755 [file join [file dirname ~] [file tail ~] td1 td2]
- file delete -force ~/td1
- set msg
-} "1 {error copying \"~/td1\" to \"td1\": \"[file join [file dirname ~] [file tail ~] td1 td2]\": permission denied}"
-test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} \
- {unixOnly notRoot xdev} {
- cleanup /tmp
- file mkdir td1/td2/td3
- file mkdir /tmp/td1
- createfile /tmp/td1/tf1
- list [catch {file rename -force td1 /tmp} msg] $msg
-} {1 {error renaming "td1" to "/tmp/td1": file already exists}}
-test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} \
- {unixOnly notRoot xdev} {
- cleanup /tmp
- file mkdir td1/td2/td3
- exec chmod 000 td1/td2/td3
- set msg [list [catch {file rename td1 /tmp} msg] $msg]
- exec chmod 755 td1/td2/td3
- set msg
-} {1 {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}}
-test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} \
- {unixOnly notRoot xdev} {
- cleanup /tmp
- file mkdir td1/td2/td3
- file rename td1 /tmp
- glob td* /tmp/td1/t*
-} {/tmp/td1/td2}
-test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} \
- {unixOnly notRoot} {
- cleanup
- file mkdir foo/bar
- file attr foo -perm 040555
- set catchResult [catch {file rename foo/bar /tmp} msg]
- set msg [lindex [split $msg :] end]
- catch {file delete /tmp/bar}
- catch {file attr foo -perm 040777}
- catch {file delete -force foo}
- list $catchResult $msg
-} {1 { permission denied}}
-test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} \
- {unixOnly notRoot xdev} {
- catch {cleanup /tmp}
- file mkdir /tmp/td1
- createfile /tmp/td1/tf1
- file rename /tmp/td1/tf1 tf1
- list [file exists /tmp/td1/tf1] [file exists tf1]
-} {0 1}
-test fCmd-6.32 {CopyRenameOneFile: copy} {notRoot} {
- cleanup
- list [catch {file copy tf1 tf2} msg] $msg
-} {1 {error copying "tf1": no such file or directory}}
-catch {cleanup /tmp}
-
-test fCmd-7.1 {FileForceOption: none} {notRoot} {
- cleanup
- file mkdir [file join tf1 tf2]
- list [catch {file delete tf1} msg] $msg
-} {1 {error deleting "tf1": directory not empty}}
-test fCmd-7.2 {FileForceOption: -force} {notRoot} {
- cleanup
- file mkdir [file join tf1 tf2]
- file delete -force tf1
-} {}
-test fCmd-7.3 {FileForceOption: --} {notRoot} {
- createfile -tf1
- file delete -- -tf1
-} {}
-test fCmd-7.4 {FileForceOption: bad option} {notRoot} {
- createfile -tf1
- set msg [list [catch {file delete -tf1} msg] $msg]
- file delete -- -tf1
- set msg
-} {1 {bad option "-tf1": should be -force or --}}
-test fCmd-7.5 {FileForceOption: multiple times through loop} {notRoot} {
- createfile --
- createfile -force
- file delete -force -force -- -- -force
- list [catch {glob -- -- -force} msg] $msg
-} {1 {no files matched glob patterns "-- -force"}}
-
-test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
- {unixOnly notRoot knownBug} {
- # Labelled knownBug because it is dangerous [Bug: 3881]
- file mkdir td1
- file attr td1 -perm 040000
- set result [list [catch {file rename ~$user td1} msg] $msg]
- file delete -force td1
- set result
-} "1 {error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied}"
-test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
- {unixOnly notRoot} {
- file tail ~$user
-} "$user"
-
-test fCmd-9.1 {file rename: comprehensive: EACCES} {unixOnly notRoot} {
- cleanup
- file mkdir td1
- file mkdir td2
- file attr td2 -perm 040000
- set result [list [catch {file rename td1 td2/} msg] $msg]
- file delete -force td2
- file delete -force td1
- set result
-} {1 {error renaming "td1" to "td2/td1": permission denied}}
-test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {notRoot} {
- cleanup
- list [catch {file rename tf1 tf2} msg] $msg
-} {1 {error renaming "tf1": no such file or directory}}
-test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot testchmod} {
- cleanup
- createfile tf1
- createfile tf2
- testchmod 444 tf2
- file rename tf1 tf3
- file rename tf2 tf4
- list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
-} {{tf3 tf4} 1 0}
-test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot testchmod} {
- cleanup
- file mkdir td1 td2
- testchmod 555 td2
- file rename td1 td3
- file rename td2 td4
- list [lsort [glob td*]] [file writable td3] [file writable td4]
-} {{td3 td4} 1 0}
-test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} {
- cleanup
- createfile tf1 tf1
- createfile tf2 tf2
- testchmod 444 tf2
- file rename -force tf1 tf1
- file rename -force tf2 tf2
- list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
-} {tf1 tf2 1 0}
-test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc testchmod} {
- cleanup
- file mkdir td1
- file mkdir td2
- testchmod 555 td2
- file rename -force td1 .
- file rename -force td2 .
- list [lsort [glob td*]] [file writable td1] [file writable td2]
-} {{td1 td2} 1 0}
-test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testchmod} {
- cleanup
- createfile tf1
- createfile tf2
- createfile tfs1
- createfile tfs2
- createfile tfs3
- createfile tfs4
- createfile tfd1
- createfile tfd2
- createfile tfd3
- createfile tfd4
- testchmod 444 tfs3
- testchmod 444 tfs4
- testchmod 444 tfd2
- testchmod 444 tfd4
- set msg [list [catch {file rename tf1 tf2} msg] $msg]
- file rename -force tfs1 tfd1
- file rename -force tfs2 tfd2
- file rename -force tfs3 tfd3
- file rename -force tfs4 tfd4
- list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
-} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
-test fCmd-9.8 {file rename: comprehensive: dir to empty dir} {notRoot testchmod} {
- # Under unix, you can rename a read-only directory, but you can't
- # move it into another directory.
-
- cleanup
- file mkdir td1
- file mkdir [file join td2 td1]
- file mkdir tds1
- file mkdir tds2
- file mkdir tds3
- file mkdir tds4
- file mkdir [file join tdd1 tds1]
- file mkdir [file join tdd2 tds2]
- file mkdir [file join tdd3 tds3]
- file mkdir [file join tdd4 tds4]
- if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
- testchmod 555 tds3
- testchmod 555 tds4
- }
- if {$tcl_platform(platform) != "macintosh"} {
- testchmod 555 [file join tdd2 tds2]
- testchmod 555 [file join tdd4 tds4]
- }
- set msg [list [catch {file rename td1 td2} msg] $msg]
- file rename -force tds1 tdd1
- file rename -force tds2 tdd2
- file rename -force tds3 tdd3
- file rename -force tds4 tdd4
- if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
- set w3 [file writable [file join tdd3 tds3]]
- set w4 [file writable [file join tdd4 tds4]]
- } else {
- set w3 0
- set w4 0
- }
- list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
- [file writable [file join tdd2 tds2]] $w3 $w4
-} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}]
-test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} {notRoot testchmod} {
- cleanup
- file mkdir tds1
- file mkdir tds2
- file mkdir [file join tdd1 tds1 xxx]
- file mkdir [file join tdd2 tds2 xxx]
- if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
- testchmod 555 tds2
- }
- set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg]
- set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg]
- if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
- set w2 [file writable tds2]
- } else {
- set w2 0
- }
- list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2
-} [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
-test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {
- cleanup
- createfile tf1
- createfile tf2
- file mkdir td1
- testchmod 444 tf2
- file rename tf1 [file join td1 tf3]
- file rename tf2 [file join td1 tf4]
- list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \
- [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
-} [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
-test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot testchmod} {
- cleanup
- file mkdir td1
- file mkdir td2
- file mkdir td3
- if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
- testchmod 555 td2
- }
- file rename td1 [file join td3 td3]
- file rename td2 [file join td3 td4]
- if {$tcl_platform(platform) != "unix" && $tcl_platform(platform) != "macintosh"} {
- set w4 [file writable [file join td3 td4]]
- } else {
- set w4 0
- }
- list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
- [file writable [file join td3 td3]] $w4
-} [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
-test fCmd-9.12 {file rename: comprehensive: target exists} {notRoot testchmod} {
- cleanup
- file mkdir [file join td1 td2] [file join td2 td1]
- if {$tcl_platform(platform) != "macintosh"} {
- testchmod 555 [file join td2 td1]
- }
- file mkdir [file join td3 td4] [file join td4 td3]
- file rename -force td3 td4
- set msg [list [file exists td3] [file exists [file join td4 td3 td4]] \
- [catch {file rename td1 td2} msg] $msg]
- if {$tcl_platform(platform) != "macintosh"} {
- testchmod 755 [file join td2 td1]
- }
- set msg
-} [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
-test fCmd-9.13 {file rename: comprehensive: can't overwrite target} {notRoot} {
- cleanup
- file mkdir [file join td1 td2] [file join td2 td1 td4]
- list [catch {file rename -force td1 td2} msg] $msg
-} [subst {1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
-test fCmd-9.14 {file rename: comprehensive: dir into self} {notRoot} {
- cleanup
- file mkdir td1
- list [glob td*] [list [catch {file rename td1 td1} msg] $msg]
-} [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
-test fCmd-9.15 {file rename: comprehensive: source and target incompatible} \
- {notRoot} {
- cleanup
- file mkdir td1
- createfile tf1
- list [catch {file rename -force td1 tf1} msg] $msg
-} {1 {can't overwrite file "tf1" with directory "td1"}}
-test fCmd-9.16 {file rename: comprehensive: source and target incompatible} \
- {notRoot} {
- cleanup
- file mkdir td1/tf1
- createfile tf1
- list [catch {file rename -force tf1 td1} msg] $msg
-} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
-
-test fCmd-10.1 {file copy: comprehensive: source doesn't exist} {notRoot} {
- cleanup
- list [catch {file copy tf1 tf2} msg] $msg
-} {1 {error copying "tf1": no such file or directory}}
-test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} {
- cleanup
- createfile tf1 tf1
- createfile tf2 tf2
- testchmod 444 tf2
- file copy tf1 tf3
- file copy tf2 tf4
- list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]
-} {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
-test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc testchmod} {
- cleanup
- file mkdir [file join td1 tdx]
- file mkdir [file join td2 tdy]
- testchmod 555 td2
- file copy td1 td3
- file copy td2 td4
- set msg [list [lsort [glob td*]] [glob -directory td3 t*] \
- [glob -directory td4 t*] [file writable td3] [file writable td4]]
- if {$tcl_platform(platform) != "macintosh"} {
- testchmod 755 td2
- testchmod 755 td4
- }
- set msg
-} [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}]
-test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testchmod} {
- cleanup
- createfile tf1
- createfile tf2
- createfile tfs1
- createfile tfs2
- createfile tfs3
- createfile tfs4
- createfile tfd1
- createfile tfd2
- createfile tfd3
- createfile tfd4
- testchmod 444 tfs3
- testchmod 444 tfs4
- testchmod 444 tfd2
- testchmod 444 tfd4
- set msg [list [catch {file copy tf1 tf2} msg] $msg]
- file copy -force tfs1 tfd1
- file copy -force tfs2 tfd2
- file copy -force tfs3 tfd3
- file copy -force tfs4 tfd4
- list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
-} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
-test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod} {
- cleanup
- file mkdir td1
- file mkdir [file join td2 td1]
- file mkdir tds1
- file mkdir tds2
- file mkdir tds3
- file mkdir tds4
- file mkdir [file join tdd1 tds1]
- file mkdir [file join tdd2 tds2]
- file mkdir [file join tdd3 tds3]
- file mkdir [file join tdd4 tds4]
- if {$tcl_platform(platform) != "macintosh"} {
- testchmod 555 tds3
- testchmod 555 tds4
- testchmod 555 [file join tdd2 tds2]
- testchmod 555 [file join tdd4 tds4]
- }
- set a1 [list [catch {file copy td1 td2} msg] $msg]
- set a2 [list [catch {file copy -force tds1 tdd1} msg] $msg]
- set a3 [catch {file copy -force tds2 tdd2}]
- set a4 [catch {file copy -force tds3 tdd3}]
- set a5 [catch {file copy -force tds4 tdd4}]
- list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5
-} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
-test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \
- {notRoot unixOrPc testchmod} {
- cleanup
- file mkdir tds1
- file mkdir tds2
- file mkdir [file join tdd1 tds1 xxx]
- file mkdir [file join tdd2 tds2 xxx]
- testchmod 555 tds2
- set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg]
- set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg]
- list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2]
-} [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
-test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {
- cleanup
- createfile tf1
- createfile tf2
- file mkdir td1
- testchmod 444 tf2
- file copy tf1 [file join td1 tf3]
- file copy tf2 [file join td1 tf4]
- list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \
- [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
-} [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
-test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \
- {notRoot unixOrPc testchmod} {
- cleanup
- file mkdir td1
- file mkdir td2
- file mkdir td3
- testchmod 555 td2
- file copy td1 [file join td3 td3]
- file copy td2 [file join td3 td4]
- list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
- [file writable [file join td3 td3]] [file writable [file join td3 td4]]
-} [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
-test fCmd-10.9 {file copy: comprehensive: source and target incompatible} \
- {notRoot} {
- cleanup
- file mkdir td1
- createfile tf1
- list [catch {file copy -force td1 tf1} msg] $msg
-} {1 {can't overwrite file "tf1" with directory "td1"}}
-test fCmd-10.10 {file copy: comprehensive: source and target incompatible} \
- {notRoot} {
- cleanup
- file mkdir [file join td1 tf1]
- createfile tf1
- list [catch {file copy -force tf1 td1} msg] $msg
-} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
-cleanup
-
-# old tests
-
-test fCmd-11.1 {TclFileRenameCmd: -- option } {notRoot} {
- catch {file delete -force -- -tfa1}
- set s [createfile -tfa1]
- file rename -- -tfa1 tfa2
- set result [expr [checkcontent tfa2 $s] && ![file exists -tfa1]]
- file delete tfa2
- set result
-} {1}
-
-test fCmd-11.2 {TclFileRenameCmd: bad option } {notRoot} {
- catch {file delete -force -- tfa1}
- set s [createfile tfa1]
- set r1 [catch {file rename -x tfa1 tfa2}]
- set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
- file delete tfa1
- set result
-} {1}
-
-test fCmd-11.3 {TclFileRenameCmd: bad \# args} {
- catch {file rename -- }
-} {1}
-
-test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {notRoot} {
- global env
- set temp $env(HOME)
- unset env(HOME)
- set result [catch {file rename tfa ~/foobar }]
- set env(HOME) $temp
- set result
- } {1}
-
-test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} {notRoot} {
- catch {file delete -force -- tfa1 tfa2 tfa3}
- createfile tfa1
- createfile tfa2
- createfile tfa3
- set result [catch {file rename tfa1 tfa2 tfa3}]
- file delete tfa1 tfa2 tfa3
- set result
-} {1}
-
-test fCmd-11.6 {TclFileRenameCmd: : single file into directory} {notRoot} {
- catch {file delete -force -- tfa1 tfad}
- set s [createfile tfa1]
- file mkdir tfad
- file rename tfa1 tfad
- set result [expr [checkcontent tfad/tfa1 $s] && ![file exists tfa1]]
- file delete -force tfad
- set result
-} {1}
-
-test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} {notRoot} {
- catch {file delete -force -- tfa1 tfa2 tfad}
- set s1 [createfile tfa1 ]
- set s2 [createfile tfa2 ]
- file mkdir tfad
- file rename tfa1 tfa2 tfad
- set r1 [checkcontent tfad/tfa1 $s1]
- set r2 [checkcontent tfad/tfa2 $s2]
-
- set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfa2]]
-
- file delete -force tfad
- set result
-} {1}
-
-test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} {notRoot} {
- catch {file delete -force -- tfa tfad}
- set s [createfile tfa ]
- file mkdir tfad
- file mkdir tfad/tfa
- set r1 [catch {file rename tfa tfad}]
- set r2 [checkcontent tfa $s]
- set r3 [file isdir tfad]
- set result [expr $r1 && $r2 && $r3 ]
- file delete -force tfa tfad
- set result
-} {1}
-
-#
-# Coverage tests for renamefile() ;
-#
-test fCmd-12.1 {renamefile: source filename translation failing} {notRoot} {
- global env
- set temp $env(HOME)
- unset env(HOME)
- set result [catch {file rename ~/tfa1 tfa2}]
- set env(HOME) $temp
- set result
-} {1}
-
-test fCmd-12.2 {renamefile: src filename translation failing} {notRoot} {
- global env
- set temp $env(HOME)
- unset env(HOME)
- set s [createfile tfa1]
- file mkdir tfad
- set result [catch {file rename tfa1 ~/tfa2 tfad}]
- set env(HOME) $temp
- file delete -force tfad
- set result
-} {1}
-
-test fCmd-12.3 {renamefile: stat failing on source} {notRoot} {
- catch {file delete -force -- tfa1 tfa2}
- set r1 [catch {file rename tfa1 tfa2}]
- expr {$r1 && ![file exists tfa1] && ![file exists tfa2]}
-} {1}
-
-test fCmd-12.4 {renamefile: error renaming file to directory} {notRoot} {
- catch {file delete -force -- tfa tfad}
- set s1 [createfile tfa ]
- file mkdir tfad
- file mkdir tfad/tfa
- set r1 [catch {file rename tfa tfad}]
- set r2 [checkcontent tfa $s1]
- set r3 [file isdir tfad/tfa]
- set result [expr $r1 && $r2 && $r3]
- file delete -force tfa tfad
- set result
-} {1}
-
-test fCmd-12.5 {renamefile: error renaming directory to file} {notRoot} {
- catch {file delete -force -- tfa tfad}
- file mkdir tfa
- file mkdir tfad
- set s [createfile tfad/tfa]
- set r1 [catch {file rename tfa tfad}]
- set r2 [checkcontent tfad/tfa $s]
- set r3 [file isdir tfad]
- set r4 [file isdir tfa]
- set result [expr $r1 && $r2 && $r3 && $r4 ]
- file delete -force tfa tfad
- set result
-} {1}
-
-test fCmd-12.6 {renamefile: TclRenameFile succeeding} {notRoot} {
- catch {file delete -force -- tfa1 tfa2}
- set s [createfile tfa1]
- file rename tfa1 tfa2
- set result [expr [checkcontent tfa2 $s] && ![file exists tfa1]]
- file delete tfa2
- set result
-} {1}
-
-test fCmd-12.7 {renamefile: renaming directory into offspring} {notRoot} {
- catch {file delete -force -- tfad}
- file mkdir tfad
- file mkdir tfad/dir
- set result [catch {file rename tfad tfad/dir}]
- file delete -force tfad
- set result
-} {1}
-
-test fCmd-12.8 {renamefile: generic error} {unixOnly notRoot} {
- catch {file delete -force -- tfa}
- file mkdir tfa
- file mkdir tfa/dir
- exec chmod 555 tfa
- set result [catch {file rename tfa/dir tfa2}]
- exec chmod 777 tfa
- file delete -force tfa
- set result
-} {1}
-
-
-test fCmd-12.9 {renamefile: moving a file across volumes} {unixOnly notRoot} {
- catch {file delete -force -- tfa /tmp/tfa}
- set s [createfile tfa ]
- file rename tfa /tmp
- set result [expr [checkcontent /tmp/tfa $s] && ![file exists tfa]]
- file delete /tmp/tfa
- set result
-} {1}
-
-test fCmd-12.10 {renamefile: moving a directory across volumes } \
- {unixOnly notRoot} {
- catch {file delete -force -- tfad /tmp/tfad}
- file mkdir tfad
- set s [createfile tfad/a ]
- file rename tfad /tmp
- set restul [expr [checkcontent /tmp/tfad/a $s] && ![file exists tfad]]
- file delete -force /tmp/tfad
- set result
-} {1}
-
-#
-# Coverage tests for TclCopyFilesCmd()
-#
-test fCmd-13.1 {TclCopyFilesCmd: -force option} {notRoot} {
- catch {file delete -force -- tfa1}
- set s [createfile tfa1]
- file copy -force tfa1 tfa2
- set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
- file delete tfa1 tfa2
- set result
-} {1}
-
-test fCmd-13.2 {TclCopyFilesCmd: -- option} {notRoot} {
- catch {file delete -force -- tfa1}
- set s [createfile -tfa1]
- file copy -- -tfa1 tfa2
- set result [expr [checkcontent tfa2 $s] && [checkcontent -tfa1 $s]]
- file delete -- -tfa1 tfa2
- set result
-} {1}
-
-test fCmd-13.3 {TclCopyFilesCmd: bad option} {notRoot} {
- catch {file delete -force -- tfa1}
- set s [createfile tfa1]
- set r1 [catch {file copy -x tfa1 tfa2}]
- set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
- file delete tfa1
- set result
-} {1}
-
-test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {notRoot} {
- catch {file copy -- }
-} {1}
-
-test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} {
- global env
- set temp $env(HOME)
- unset env(HOME)
- set result [catch {file copy tfa ~/foobar }]
- set env(HOME) $temp
- set result
- } {1}
-
-test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} {notRoot} {
- catch {file delete -force -- tfa1 tfa2 tfa3}
- createfile tfa1
- createfile tfa2
- createfile tfa3
- set result [catch {file copy tfa1 tfa2 tfa3}]
- file delete tfa1 tfa2 tfa3
- set result
-} {1}
-
-test fCmd-13.7 {TclCopyFilesCmd: single file into directory} {notRoot} {
- catch {file delete -force -- tfa1 tfad}
- set s [createfile tfa1]
- file mkdir tfad
- file copy tfa1 tfad
- set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]]
- file delete -force tfad tfa1
- set result
-} {1}
-
-test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} {notRoot} {
- catch {file delete -force -- tfa1 tfa2 tfad}
- set s1 [createfile tfa1 ]
- set s2 [createfile tfa2 ]
- file mkdir tfad
- file copy tfa1 tfa2 tfad
- set r1 [checkcontent tfad/tfa1 $s1]
- set r2 [checkcontent tfad/tfa2 $s2]
- set r3 [checkcontent tfa1 $s1]
- set r4 [checkcontent tfa2 $s2]
- set result [expr $r1 && $r2 && $r3 && $r4 ]
-
- file delete -force tfad tfa1 tfa2
- set result
-} {1}
-
-test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} {notRoot} {
- catch {file delete -force -- tfa tfad}
- set s [createfile tfa ]
- file mkdir tfad
- file mkdir tfad/tfa
- set r1 [catch {file copy tfa tfad}]
- set r2 [expr [checkcontent tfa $s] && [file isdir tfad/tfa]]
- set r3 [file isdir tfad]
- set result [expr $r1 && $r2 && $r3 ]
- file delete -force tfa tfad
- set result
-} {1}
-
-#
-# Coverage tests for copyfile()
-#
-test fCmd-14.1 {copyfile: source filename translation failing} {notRoot} {
- global env
- set temp $env(HOME)
- unset env(HOME)
- set result [catch {file copy ~/tfa1 tfa2}]
- set env(HOME) $temp
- set result
-} {1}
-
-test fCmd-14.2 {copyfile: dst filename translation failing} {notRoot} {
- global env
- set temp $env(HOME)
- unset env(HOME)
- set s [createfile tfa1]
- file mkdir tfad
- set r1 [catch {file copy tfa1 ~/tfa2 tfad}]
- set result [expr $r1 && [checkcontent tfad/tfa1 $s]]
- set env(HOME) $temp
- file delete -force tfa1 tfad
- set result
-} {1}
-
-test fCmd-14.3 {copyfile: stat failing on source} {notRoot} {
- catch {file delete -force -- tfa1 tfa2}
- set r1 [catch {file copy tfa1 tfa2}]
- expr $r1 && ![file exists tfa1] && ![file exists tfa2]
-} {1}
-
-test fCmd-14.4 {copyfile: error copying file to directory} {notRoot} {
- catch {file delete -force -- tfa tfad}
- set s1 [createfile tfa ]
- file mkdir tfad
- file mkdir tfad/tfa
- set r1 [catch {file copy tfa tfad}]
- set r2 [checkcontent tfa $s1]
- set r3 [file isdir tfad]
- set r4 [file isdir tfad/tfa]
- set result [expr $r1 && $r2 && $r3 && $r4 ]
- file delete -force tfa tfad
- set result
-} {1}
-
- test fCmd-14.5 {copyfile: error copying directory to file} {notRoot} {
- catch {file delete -force -- tfa tfad}
- file mkdir tfa
- file mkdir tfad
- set s [createfile tfad/tfa]
- set r1 [catch {file copy tfa tfad}]
- set r2 [checkcontent tfad/tfa $s]
- set r3 [file isdir tfad]
- set r4 [file isdir tfa]
- set result [expr $r1 && $r2 && $r3 && $r4 ]
- file delete -force tfa tfad
- set result
-} {1}
-
-test fCmd-14.6 {copyfile: copy file succeeding} {notRoot} {
- catch {file delete -force -- tfa tfa2}
- set s [createfile tfa]
- file copy tfa tfa2
- set result [expr [checkcontent tfa $s] && [checkcontent tfa2 $s]]
- file delete tfa tfa2
- set result
-} {1}
-
-test fCmd-14.7 {copyfile: copy directory succeeding} {notRoot} {
- catch {file delete -force -- tfa tfa2}
- file mkdir tfa
- set s [createfile tfa/file]
- file copy tfa tfa2
- set result [expr [checkcontent tfa/file $s] && [checkcontent tfa2/file $s]]
- file delete -force tfa tfa2
- set result
-} {1}
-
-test fCmd-14.8 {copyfile: copy directory failing} {unixOnly notRoot} {
- catch {file delete -force -- tfa}
- file mkdir tfa/dir/a/b/c
- exec chmod 000 tfa/dir
- set r1 [catch {file copy tfa tfa2}]
- exec chmod 777 tfa/dir
- set result $r1
- file delete -force tfa tfa2
- set result
-} {1}
-
-#
-# Coverage tests for TclMkdirCmd()
-#
-test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {notRoot} {
- global env
- set temp $env(HOME)
- unset env(HOME)
- set result [catch {file mkdir ~/tfa}]
- set env(HOME) $temp
- set result
-} {1}
-#
-# Can Tcl_SplitPath return argc == 0? If so them we need a
-# test for that code.
-#
-test fCmd-15.2 {TclMakeDirsCmd - one directory } {notRoot} {
- catch {file delete -force -- tfa}
- file mkdir tfa
- set result [file isdirectory tfa]
- file delete tfa
- set result
-} {1}
-
-test fCmd-15.3 {TclMakeDirsCmd: - two directories} {notRoot} {
- catch {file delete -force -- tfa1 tfa2}
- file mkdir tfa1 tfa2
- set result [expr [file isdirectory tfa1] && [file isdirectory tfa2]]
- file delete tfa1 tfa2
- set result
-} {1}
-
-test fCmd-15.4 {TclMakeDirsCmd - stat failing} {unixOnly notRoot} {
- catch {file delete -force -- tfa}
- file mkdir tfa
- createfile tfa/file
- exec chmod 000 tfa
- set result [catch {file mkdir tfa/file}]
- exec chmod 777 tfa
- file delete -force tfa
- set result
-} {1}
-
-test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} \
- {notRoot} {
- catch {file delete -force -- tfa}
- file mkdir tfa/a/b/c
- set result [file isdir tfa/a/b/c]
- file delete -force tfa
- set result
-} {1}
-
-
-test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} {notRoot} {
- catch {file delete -force -- tfa}
- set s [createfile tfa]
- set r1 [catch {file mkdir tfa}]
- set r2 [file isdir tfa]
- set r3 [file exists tfa]
- set result [expr $r1 && !$r2 && $r3 && [checkcontent tfa $s]]
- file delete tfa
- set result
-} {1}
-
-test fCmd-15.7 {TclMakeDirsCmd - making several directories} {notRoot} {
- catch {file delete -force -- tfa1 tfa2}
- file mkdir tfa1 tfa2/a/b/c
- set result [expr [file isdir tfa1] && [file isdir tfa2/a/b/c]]
- file delete -force tfa1 tfa2
- set result
-} {1}
-
-test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {notRoot} {
- file mkdir tfa
- file mkdir tfa
- set result [file isdir tfa]
- file delete tfa
- set result
-} {1}
-
-
-# Coverage tests for TclDeleteFilesCommand()
-test fCmd-16.1 { test the -- argument } {notRoot} {
- catch {file delete -force -- tfa}
- createfile tfa
- file delete -- tfa
- file exists tfa
-} {0}
-
-test fCmd-16.2 { test the -force and -- arguments } {notRoot} {
- catch {file delete -force -- tfa}
- createfile tfa
- file delete -force -- tfa
- file exists tfa
-} {0}
-
-test fCmd-16.3 { test bad option } {notRoot} {
- catch {file delete -force -- tfa}
- createfile tfa
- set result [catch {file delete -dog tfa}]
- file delete tfa
- set result
-} {1}
-
-test fCmd-16.4 { test not enough args } {notRoot} {
- catch {file delete}
-} {1}
-
-test fCmd-16.5 { test not enough args with options } {notRoot} {
- catch {file delete --}
-} {1}
-
-test fCmd-16.6 {delete: source filename translation failing} {notRoot} {
- global env
- set temp $env(HOME)
- unset env(HOME)
- set result [catch {file delete ~/tfa}]
- set env(HOME) $temp
- set result
-} {1}
-
-test fCmd-16.7 {remove a non-empty directory without -force } {notRoot} {
- catch {file delete -force -- tfa}
- file mkdir tfa
- createfile tfa/a
- set result [catch {file delete tfa }]
- file delete -force tfa
- set result
-} {1}
-
-test fCmd-16.8 {remove a normal file } {notRoot} {
- catch {file delete -force -- tfa}
- file mkdir tfa
- createfile tfa/a
- set result [catch {file delete tfa }]
- file delete -force tfa
- set result
-} {1}
-
-test fCmd-16.9 {error while deleting file } {unixOnly notRoot} {
- catch {file delete -force -- tfa}
- file mkdir tfa
- createfile tfa/a
- exec chmod 555 tfa
- set result [catch {file delete tfa/a }]
- #######
- ####### If any directory in a tree that is being removed does not
- ####### have write permission, the process will fail!
- ####### This is also the case with "rm -rf"
- #######
- exec chmod 777 tfa
- file delete -force tfa
- set result
-} {1}
-
-test fCmd-16.10 {deleting multiple files} {notRoot} {
- catch {file delete -force -- tfa1 tfa2}
- createfile tfa1
- createfile tfa2
- file delete tfa1 tfa2
- expr ![file exists tfa1] && ![file exists tfa2]
-} {1}
-
-test fCmd-16.11 { TclFileDeleteCmd: removing a nonexistant file} {notRoot} {
- catch {file delete -force -- tfa}
- file delete tfa
- set result 1
-} {1}
-
-# More coverage tests for mkpath()
- test fCmd-17.1 {mkdir stat failing on target but not ENOENT} {unixOnly notRoot} {
- catch {file delete -force -- tfa1}
- file mkdir tfa1
- exec chmod 555 tfa1
- set result [catch {file mkdir tfa1/tfa2}]
- exec chmod 777 tfa1
- file delete -force tfa1
- set result
-} {1}
-
-test fCmd-17.2 {mkdir several levels deep - relative } {notRoot} {
- catch {file delete -force -- tfa}
- file mkdir tfa/a/b
- set result [file isdir tfa/a/b ]
- file delete tfa/a/b tfa/a tfa
- set result
-} {1}
-
-test fCmd-17.3 {mkdir several levels deep - absolute } {notRoot} {
- catch {file delete -force -- tfa}
- set f [file join [pwd] tfa a ]
- file mkdir $f
- set result [file isdir $f ]
- file delete $f [file join [pwd] tfa]
- set result
-} {1}
-
-#
-# Functionality tests for TclFileRenameCmd()
-#
-
-test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
- {notRoot} {
- catch {file delete -force -- tfad}
- file mkdir tfad/dir
- cd tfad/dir
- set s [createfile foo ]
- file rename foo bar
- file rename bar ./foo
- file rename ./foo bar
- file rename ./bar ./foo
- file rename foo ../dir/bar
- file rename ../dir/bar ./foo
- file rename ../../tfad/dir/foo ../../tfad/dir/bar
- file rename [file join [pwd] bar] foo
- file rename foo [file join [pwd] bar]
- set result [expr [checkcontent bar $s] && ![file exists foo]]
- cd ../..
- file delete -force tfad
- set result
-} {1}
-
-test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} {notRoot} {
- catch {file delete -force -- tfa1 tfa2}
- file mkdir tfa1
- file rename tfa1 tfa2
- set result [expr [file exists tfa2] && ![file exists tfa1]]
- file delete tfa2
- set result
-} {1}
-
-test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} {notRoot} {
- catch {file delete -force -- tfa1 tfad1 tfad2}
- set s [createfile tfa1 ]
- file mkdir tfad1 tfad2
- file rename tfa1 tfad1 tfad2
- set r1 [checkcontent tfad2/tfa1 $s]
- set r2 [file isdir tfad2/tfad1]
- set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfad1]]
- file delete tfad2/tfa1
- file delete -force tfad2
- set result
-} {1}
-
-test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} {notRoot} {
- catch {file delete -force -- tfa tfad}
- set s [createfile tfa ]
- file mkdir tfad
- set r1 [catch {file rename tfad tfa}]
- set r2 [checkcontent tfa $s]
- set r3 [file isdir tfad]
- set result [expr $r1 && $r2 && $r3 ]
- file delete tfa tfad
- set result
-} {1}
-
-test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} {notRoot} {
- catch {file delete -force -- tfa tfad}
- set s [createfile tfa ]
- file mkdir tfad/tfa
- set r1 [catch {file rename tfa tfad}]
- set r2 [checkcontent tfa $s]
- set r3 [file isdir tfad/tfa]
- set result [expr $r1 && $r2 && $r3 ]
- file delete -force tfa tfad
- set result
-} {1}
-
-#
-# On Windows there is no easy way to determine if two files are the same
-#
-test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} {macOrUnix notRoot} {
- catch {file delete -force -- tfa}
- set s [createfile tfa]
- set r1 [catch {file rename tfa tfa}]
- set result [expr $r1 && [checkcontent tfa $s]]
- file delete tfa
- set result
-} {1}
-
-test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} \
- {notRoot} {
- catch {file delete -force -- tfa tfad}
- file mkdir tfa tfad/tfa
- set r1 [catch {file rename tfa tfad}]
- set result [expr $r1 && [file isdir tfa]]
- file delete -force tfa tfad
- set result
-} {1}
-
-test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} \
- {notRoot} {
- catch {file delete -force -- tfa tfad}
- file mkdir tfa tfad/tfa
- file rename -force tfa tfad
- set result [expr ![file isdir tfa]]
- file delete -force tfad
- set result
-} {1}
-
-test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} \
- {notRoot} {
- catch {file delete -force -- tfa tfad}
- file mkdir tfa tfad/tfa/file
- set r1 [catch {file rename tfa tfad}]
- set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
- file delete -force tfa tfad
- set result
-} {1}
-
-test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} \
- {notRoot} {
- catch {file delete -force -- tfa tfad}
- file mkdir tfa tfad/tfa/file
- set r1 [catch {file rename -force tfa tfad}]
- set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
- file delete -force tfa tfad
- set result
-} {1}
-
-test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} {notRoot} {
- catch {file delete -force -- tfa1}
- set r1 [catch {file rename tfa1 tfa2}]
- set result [expr $r1 && ![file exists tfa1] && ![file exists tfa2]]
-} {1}
-
-test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} \
- {unixOnly notRoot} {
- catch {file delete -force -- tfa1 tfa2 tfa3}
-
- set s [createfile tfa1]
- exec ln -s tfa1 tfa2
- file rename tfa2 tfa3
- set t [file type tfa3]
- set result [expr { $t == "link" }]
- file delete tfa1 tfa3
- set result
-} {1}
-
-test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} \
- {unixOnly notRoot} {
- catch {file delete -force -- tfa1 tfa2 tfa3}
-
- file mkdir tfa1
- exec ln -s tfa1 tfa2
- file rename tfa2 tfa3
- set t [file type tfa3]
- set result [expr { $t == "link" }]
- file delete tfa1 tfa3
- set result
-} {1}
-
-test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} \
- {unixOnly notRoot} {
- catch {file delete -force -- tfa1 tfa2 tfa3}
-
- file mkdir tfa1/a/b/c/d
- file mkdir tfa2
- set f [file join [pwd] tfa1/a/b]
- set f2 [file join [pwd] {tfa2/b alias}]
- exec ln -s $f $f2
- file rename {tfa2/b alias/c} tfa3
- set r1 [file isdir tfa3]
- set r2 [file exists tfa1/a/b/c]
- set result [expr $r1 && !$r2]
- file delete -force tfa1 tfa2 tfa3
- set result
-} {1}
-
-test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} \
- {unixOnly notRoot} {
- catch {file delete -force -- tfa1 tfa2 tfalink}
-
- file mkdir tfa1
- set s [createfile tfa2]
- exec ln -s tfa1 tfalink
-
- file rename tfa2 tfalink
- set result [checkcontent tfa1/tfa2 $s ]
- file delete -force tfa1 tfalink
- set result
-} {1}
-
-test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unixOnly notRoot} {
- catch {file delete -force -- tfa1 tfalink}
-
- file mkdir tfa1
- exec ln -s tfa1 tfalink
- file delete tfa1
- file rename tfalink tfa2
- set result [expr [string compare [file type tfa2] "link"] == 0]
- file delete tfa2
- set result
-} {1}
-
-
-#
-# Coverage tests for TclUnixRmdir
-#
-test fCmd-19.1 { remove empty directory } {notRoot} {
- catch {file delete -force -- tfa}
- file mkdir tfa
- file delete tfa
- file exists tfa
-} {0}
-
-test fCmd-19.2 { rmdir error besides EEXIST} {unixOnly notRoot} {
- catch {file delete -force -- tfa}
- file mkdir tfa
- file mkdir tfa/a
- exec chmod 555 tfa
- set result [catch {file delete tfa/a}]
- exec chmod 777 tfa
- file delete -force tfa
- set result
-} {1}
-
-test fCmd-19.3 { recursive remove } {notRoot} {
- catch {file delete -force -- tfa}
- file mkdir tfa
- file mkdir tfa/a
- file delete -force tfa
- file exists tfa
-} {0}
-
-#
-# TclUnixDeleteFile and TraversalDelete are covered by tests from the
-# TclDeleteFilesCmd suite
-#
-#
-
-#
-# Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
-#
-
-test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } \
- {unixOnly notRoot} {
- catch {file delete -force -- tfa}
- file mkdir tfa
- file mkdir tfa/a
- exec chmod 000 tfa/a
- set result [catch {file delete -force tfa}]
- exec chmod 777 tfa/a
- file delete -force tfa
- set result
-} {1}
-
-
-#
-# Feature testing for TclCopyFilesCmd
-#
-test fCmd-21.1 {copy : single file to nonexistant } {notRoot} {
- catch {file delete -force -- tfa1 tfa2}
- set s [createfile tfa1]
- file copy tfa1 tfa2
- set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
- file delete tfa1 tfa2
- set result
-} {1}
-
-test fCmd-21.2 {copy : single dir to nonexistant } {notRoot} {
- catch {file delete -force -- tfa1 tfa2}
- file mkdir tfa1
- file copy tfa1 tfa2
- set result [expr [file isdir tfa2] && [file isdir tfa1]]
- file delete tfa1 tfa2
- set result
-} {1}
-
-test fCmd-21.3 {copy : single file into directory } {notRoot} {
- catch {file delete -force -- tfa1 tfad}
- set s [createfile tfa1]
- file mkdir tfad
- file copy tfa1 tfad
- set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]]
- file delete -force tfa1 tfad
- set result
-} {1}
-
-test fCmd-21.4 {copy : more than one source and target is not a directory} \
- {notRoot} {
- catch {file delete -force -- tfa1 tfa2 tfa3}
- createfile tfa1
- createfile tfa2
- createfile tfa3
- set result [catch {file copy tfa1 tfa2 tfa3}]
- file delete tfa1 tfa2 tfa3
- set result
-} {1}
-
-test fCmd-21.5 {copy : multiple files into directory } {notRoot} {
- catch {file delete -force -- tfa1 tfa2 tfad}
- set s1 [createfile tfa1 ]
- set s2 [createfile tfa2 ]
- file mkdir tfad
- file copy tfa1 tfa2 tfad
- set r1 [checkcontent tfad/tfa1 $s1]
- set r2 [checkcontent tfad/tfa2 $s2]
- set r3 [checkcontent tfa1 $s1]
- set r4 [checkcontent tfa2 $s2]
- set result [expr $r1 && $r2 && $r3 && $r4]
- file delete -force tfa1 tfa2 tfad
- set result
-} {1}
-
-test fCmd-21.6 {copy: mixed dirs and files into directory} \
- {notRoot notFileSharing} {
- catch {file delete -force -- tfa1 tfad1 tfad2}
- set s [createfile tfa1 ]
- file mkdir tfad1 tfad2
- file copy tfa1 tfad1 tfad2
- set r1 [checkcontent [file join tfad2 tfa1] $s]
- set r2 [file isdir [file join tfad2 tfad1]]
- set r3 [checkcontent tfa1 $s]
- set result [expr $r1 && $r2 && $r3 && [file isdir tfad1]]
- file delete -force tfa1 tfad1 tfad2
- set result
-} {1}
-
-test fCmd-21.7 {TclCopyFilesCmd: copy a dangling link} {unixOnly notRoot} {
- file mkdir tfad1
- exec ln -s tfad1 tfalink
- file delete tfad1
- file copy tfalink tfalink2
- set result [string match [file type tfalink2] link]
- file delete tfalink tfalink2
- set result
-} {1}
-
-test fCmd-21.8 {TclCopyFilesCmd : copy a link } {unixOnly notRoot} {
- file mkdir tfad1
- exec ln -s tfad1 tfalink
- file copy tfalink tfalink2
- set r1 [file type tfalink]
- set r2 [file type tfalink2]
- set r3 [file isdir tfad1]
- set result [expr {("$r1" == "link" ) && ("$r2" == "link" ) && $r3}]
- file delete tfad1 tfalink tfalink2
- set result
-} {1}
-
-test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} {unixOnly notRoot} {
- file mkdir tfad1
- exec ln -s "[pwd]/tfad1" tfad1/tfalink
- file copy tfad1 tfad2
- set result [string match [file type tfad2/tfalink] link]
- file delete -force tfad1 tfad2
- set result
-} {1}
-
-test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} \
- {notRoot} {
- catch {file delete -force -- tfa tfad}
- file mkdir tfa [file join tfad tfa]
- set r1 [catch {file copy tfa tfad}]
- set result [expr $r1 && [file isdir tfa]]
- file delete -force tfa tfad
- set result
-} {1}
-
-test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} {notRoot} {
- catch {file delete -force -- tfa tfad}
- file mkdir tfa [file join tfad tfa file]
- set r1 [catch {file copy tfa tfad}]
- set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
- file delete -force tfa tfad
- set result
-} {1}
-
-test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} \
- {notRoot} {
- catch {file delete -force -- tfa tfad}
- file mkdir tfa [file join tfad tfa file]
- set r1 [catch {file copy -force tfa tfad}]
- set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
- file delete -force tfa tfad
- set result
-} {1}
-
-#
-# Coverage testing for TclpRenameFile
-#
-test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} {notRoot} {
- catch {file delete -force -- tfa1 tfa2}
- set s [createfile tfa1]
- set s2 [createfile tfa2 q]
-
- set r1 [catch {rename tfa1 tfa2}]
- file rename -force tfa1 tfa2
- set result [expr $r1 && [checkcontent tfa2 $s]]
- file delete [glob tfa1 tfa2]
- set result
-} {1}
-
-test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} {macOrUnix notRoot} {
- catch {file delete -force -- tfa1}
- set s [createfile tfa1]
- file rename -force tfa1 tfa1
- set result [checkcontent tfa1 $s]
- file delete tfa1
- set result
-} {1}
-
-test fCmd-22.3 { TclpRenameFile : rename dir to existing dir } {notRoot} {
- catch {file delete -force -- d1 tfad}
- file mkdir d1 [file join tfad d1]
- set r1 [catch {file rename d1 tfad}]
- set result [expr $r1 && [file isdir d1] && [file isdir [file join tfad d1]]]
- file delete -force d1 tfad
- set result
-} {1}
-
-test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} {notRoot} {
- catch {file delete -force -- d1 tfad}
- file mkdir d1 [file join tfad a b c]
- file rename d1 [file join tfad a b c d1]
- set result [expr ![file isdir d1] && [file isdir [file join tfad a b c d1]]]
- file delete -force [glob d1 tfad]
- set result
-} {1}
-
-
-#
-# TclMacCopyFile needs to be redone.
-#
-test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} {notRoot} {
- catch {file delete -force -- tfa1 tfa2}
- set s [createfile tfa1]
- set s2 [createfile tfa2 q]
-
- set r1 [catch {file copy tfa1 tfa2}]
- file copy -force tfa1 tfa2
- set result [expr $r1 && [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
- file delete tfa1 tfa2
- set result
-} {1}
-
-#
-# TclMacMkdir - basic cases are covered elsewhere.
-# Error cases are not covered.
-#
-
-#
-# TclMacRmdir
-# Error cases are not covered.
-#
-
-test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} {notRoot} {
- catch {file delete -force -- tfad}
-
- file mkdir [file join tfad dir]
-
- set result [catch {file delete tfad}]
- file delete -force tfad
- set result
-} {1}
-
-#
-# TclMacDeleteFile
-# Error cases are not covered.
-#
-test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} {notRoot} {
- catch {file delete -force -- tfa1}
-
- createfile tfa1
- file delete tfa1
- file exists tfa1
-} {0}
-
-#
-# TclMacCopyDirectory
-# Error cases are not covered.
-#
-test fCmd-25.1 { TclMacCopyDirectory : copying a normal directory} \
- {notRoot notFileSharing} {
- catch {file delete -force -- tfad1 tfad2}
-
- file mkdir [file join tfad1 a b c]
- file copy tfad1 tfad2
- set result [expr [file isdir [file join tfad1 a b c]] && [file isdir [file join tfad2 a b c]]]
- file delete -force tfad1 tfad2
- set result
-} {1}
-
-test fCmd-25.2 { TclMacCopyDirectory : copying a short path normal directory} \
- {notRoot notFileSharing} {
- catch {file delete -force -- tfad1 tfad2}
-
- file mkdir tfad1
- file copy tfad1 tfad2
- set result [expr [file isdir tfad1] && [file isdir tfad2]]
- file delete tfad1 tfad2
- set result
-} {1}
-
-test fCmd-25.3 { TclMacCopyDirectory : copying dirs between different dirs} \
- {notRoot notFileSharing} {
- catch {file delete -force -- tfad1 tfad2}
-
- file mkdir [file join tfad1 x y z]
- file mkdir [file join tfad2 dir]
- file copy tfad1 [file join tfad2 dir]
- set result [expr [file isdir [file join tfad1 x y z]] && [file isdir [file join tfad2 dir tfad1 x y z]]]
- file delete -force tfad1 tfad2
- set result
-} {1}
-
-#
-# Functionality tests for TclDeleteFilesCmd
-#
-
-test fCmd-26.1 { TclDeleteFilesCmd : delete symlink} {unixOnly notRoot} {
- catch {file delete -force -- tfad1 tfad2}
-
- file mkdir tfad1
- exec ln -s tfad1 tfalink
- file delete tfalink
-
- set r1 [file isdir tfad1]
- set r2 [file exists tfalink]
-
- set result [expr $r1 && !$r2]
- file delete tfad1
- set result
-} {1}
-
-test fCmd-26.2 { TclDeleteFilesCmd : delete dir with symlink} {unixOnly notRoot} {
- catch {file delete -force -- tfad1 tfad2}
-
- file mkdir tfad1
- file mkdir tfad2
- exec ln -s tfad1 [file join tfad2 link]
- file delete -force tfad2
-
- set r1 [file isdir tfad1]
- set r2 [file exists tfad2]
-
- set result [expr $r1 && !$r2]
- file delete tfad1
- set result
-} {1}
-
-test fCmd-26.3 { TclDeleteFilesCmd : delete dangling symlink} {unixOnly notRoot} {
- catch {file delete -force -- tfad1 tfad2}
-
- file mkdir tfad1
- exec ln -s tfad1 tfad2
- file delete tfad1
- file delete tfad2
-
- set r1 [file exists tfad1]
- set r2 [file exists tfad2]
-
- set result [expr !$r1 && !$r2]
- set result
-} {1}
-
-test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} {testsetplatform} {
- set platform [testgetplatform]
- testsetplatform unix
- list [catch {file attributes ~_totally_bogus_user} msg] $msg [testsetplatform $platform]
-} {1 {user "_totally_bogus_user" doesn't exist} {}}
-test fCmd-27.3 {TclFileAttrsCmd - all attributes} {
- catch {file delete -force -- foo.tmp}
- createfile foo.tmp
- list [catch {file attributes foo.tmp} msg] [expr {[llength $msg] > 0}] [file delete -force -- foo.tmp]
-} {0 1 {}}
-test fCmd-27.4 {TclFileAttrsCmd - getting one option} {
- catch {file delete -force -- foo.tmp}
- createfile foo.tmp
- set attrs [file attributes foo.tmp]
- list [catch {eval file attributes foo.tmp [lindex $attrs 0]}] [file delete -force -- foo.tmp]
-} {0 {}}
-
-# Find a group that exists on this Unix system, or else skip tests that
-# require Unix groups.
-if {$tcl_platform(platform) == "unix"} {
- set ::tcltest::testConstraints(foundGroup) 0
- catch {
- set groupList [exec groups]
- set group [lindex $groupList 0]
- set ::tcltest::testConstraints(foundGroup) 1
- }
-} else {
- set ::tcltest::testConstraints(foundGroup) 1
-}
-
-test fCmd-27.5 {TclFileAttrsCmd - setting one option} {foundGroup} {
- catch {file delete -force -- foo.tmp}
- createfile foo.tmp
- set attrs [file attributes foo.tmp]
- list [catch {eval file attributes foo.tmp [lrange $attrs 0 1]} msg] $msg [file delete -force -- foo.tmp]
-} {0 {} {}}
-test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} {
- catch {file delete -force -- foo.tmp}
- createfile foo.tmp
- set attrs [file attributes foo.tmp]
- list [catch {eval file attributes foo.tmp [lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]
-} {0 {} {}}
-
-# cleanup
-cleanup
-::tcltest::cleanupTests
-return
-
-
-
-
-
-
-
-
-
-
-
-
+++ /dev/null
-# This file tests the filename manipulation routines.
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
-#
-# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# Copyright (c) 1999 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id$
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-tcltest::testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]]
-tcltest::testConstraint testtranslatefilename [string equal testtranslatefilename [info commands testtranslatefilename]]
-
-global env
-if {[tcltest::testConstraint testsetplatform]} {
- set platform [testgetplatform]
-}
-
-test filename-1.1 {Tcl_GetPathType: unix} {testsetplatform} {
- testsetplatform unix
- file pathtype /
-} absolute
-test filename-1.2 {Tcl_GetPathType: unix} {testsetplatform} {
- testsetplatform unix
- file pathtype /foo
-} absolute
-test filename-1.3 {Tcl_GetPathType: unix} {testsetplatform} {
- testsetplatform unix
- file pathtype foo
-} relative
-test filename-1.4 {Tcl_GetPathType: unix} {testsetplatform} {
- testsetplatform unix
- file pathtype c:/foo
-} relative
-test filename-1.5 {Tcl_GetPathType: unix} {testsetplatform} {
- testsetplatform unix
- file pathtype ~
-} absolute
-test filename-1.6 {Tcl_GetPathType: unix} {testsetplatform} {
- testsetplatform unix
- file pathtype ~/foo
-} absolute
-test filename-1.7 {Tcl_GetPathType: unix} {testsetplatform} {
- testsetplatform unix
- file pathtype ~foo
-} absolute
-test filename-1.8 {Tcl_GetPathType: unix} {testsetplatform} {
- testsetplatform unix
- file pathtype ./~foo
-} relative
-
-test filename-2.1 {Tcl_GetPathType: mac, denerate names} {testsetplatform} {
- testsetplatform mac
- file pathtype /
-} relative
-test filename-2.2 {Tcl_GetPathType: mac, denerate names} {testsetplatform} {
- testsetplatform mac
- file pathtype /.
-} relative
-test filename-2.3 {Tcl_GetPathType: mac, denerate names} {testsetplatform} {
- testsetplatform mac
- file pathtype /..
-} relative
-test filename-2.4 {Tcl_GetPathType: mac, denerate names} {testsetplatform} {
- testsetplatform mac
- file pathtype //.//
-} relative
-test filename-2.5 {Tcl_GetPathType: mac, denerate names} {testsetplatform} {
- testsetplatform mac
- file pathtype //.//../.
-} relative
-test filename-2.6 {Tcl_GetPathType: mac, tilde names} {testsetplatform} {
- testsetplatform mac
- file pathtype ~
-} absolute
-test filename-2.7 {Tcl_GetPathType: mac, tilde names} {testsetplatform} {
- testsetplatform mac
- file pathtype ~:
-} absolute
-test filename-2.8 {Tcl_GetPathType: mac, tilde names} {testsetplatform} {
- testsetplatform mac
- file pathtype ~:foo
-} absolute
-test filename-2.9 {Tcl_GetPathType: mac, tilde names} {testsetplatform} {
- testsetplatform mac
- file pathtype ~/
-} absolute
-test filename-2.10 {Tcl_GetPathType: mac, tilde names} {testsetplatform} {
- testsetplatform mac
- file pathtype ~/foo
-} absolute
-test filename-2.11 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype /foo
-} absolute
-test filename-2.12 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype /./foo
-} absolute
-test filename-2.13 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype /..//./foo
-} absolute
-test filename-2.14 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype /foo/bar
-} absolute
-test filename-2.15 {Tcl_GetPathType: mac, unix-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype foo/bar
-} relative
-test filename-2.16 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype :
-} relative
-test filename-2.17 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype :foo
-} relative
-test filename-2.18 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype foo:
-} absolute
-test filename-2.19 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype foo:bar
-} absolute
-test filename-2.20 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype :foo:bar
-} relative
-test filename-2.21 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype ::foo:bar
-} relative
-test filename-2.22 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype ~foo
-} absolute
-test filename-2.23 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype :~foo
-} relative
-test filename-2.24 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype ~foo:
-} absolute
-test filename-2.25 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype foo/bar:
-} absolute
-test filename-2.26 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype /foo:
-} absolute
-test filename-2.27 {Tcl_GetPathType: mac, mac-style names} {testsetplatform} {
- testsetplatform mac
- file pathtype foo
-} relative
-
-test filename-3.1 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype /
-} volumerelative
-test filename-3.2 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype \\
-} volumerelative
-test filename-3.3 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype /foo
-} volumerelative
-test filename-3.4 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype \\foo
-} volumerelative
-test filename-3.5 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype c:/
-} absolute
-test filename-3.6 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype c:\\
-} absolute
-test filename-3.7 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype c:/foo
-} absolute
-test filename-3.8 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype c:\\foo
-} absolute
-test filename-3.9 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype c:
-} volumerelative
-test filename-3.10 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype c:foo
-} volumerelative
-test filename-3.11 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype foo
-} relative
-test filename-3.12 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype //foo/bar
-} absolute
-test filename-3.13 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype ~foo
-} absolute
-test filename-3.14 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype ~
-} absolute
-test filename-3.15 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype ~/foo
-} absolute
-test filename-3.16 {Tcl_GetPathType: windows} {testsetplatform} {
- testsetplatform windows
- file pathtype ./~foo
-} relative
-
-test filename-4.1 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split /
-} {/}
-test filename-4.2 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split /foo
-} {/ foo}
-test filename-4.3 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split /foo/bar
-} {/ foo bar}
-test filename-4.4 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split /foo/bar/baz
-} {/ foo bar baz}
-test filename-4.5 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split foo/bar
-} {foo bar}
-test filename-4.6 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split ./foo/bar
-} {. foo bar}
-test filename-4.7 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split /foo/../././foo/bar
-} {/ foo .. . . foo bar}
-test filename-4.8 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split ../foo/bar
-} {.. foo bar}
-test filename-4.9 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split {}
-} {}
-test filename-4.10 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split .
-} {.}
-test filename-4.11 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split ../
-} {..}
-test filename-4.12 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split ../..
-} {.. ..}
-test filename-4.13 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split //foo
-} {/ foo}
-test filename-4.14 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split foo//bar
-} {foo bar}
-test filename-4.15 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split ~foo
-} {~foo}
-test filename-4.16 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split ~foo/~bar
-} {~foo ./~bar}
-test filename-4.17 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split ~foo/~bar/~baz
-} {~foo ./~bar ./~baz}
-test filename-4.18 {Tcl_SplitPath: unix} {testsetplatform} {
- testsetplatform unix
- file split foo/bar~/baz
-} {foo bar~ baz}
-
-test filename-5.1 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split a:b
-} {a: b}
-test filename-5.2 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split a:b:c
-} {a: b c}
-test filename-5.3 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split a:b:c:
-} {a: b c}
-test filename-5.4 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split a:
-} {a:}
-test filename-5.5 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split a::
-} {a: ::}
-test filename-5.6 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split a:::
-} {a: :: ::}
-test filename-5.7 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split :a
-} {a}
-test filename-5.8 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split :a::
-} {a ::}
-test filename-5.9 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split :
-} {:}
-test filename-5.10 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ::
-} {::}
-test filename-5.11 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split :::
-} {:: ::}
-test filename-5.12 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split a:::b
-} {a: :: :: b}
-test filename-5.13 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split /a:b
-} {/a: b}
-test filename-5.14 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ~:
-} {~:}
-test filename-5.15 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ~/:
-} {~/:}
-test filename-5.16 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ~:foo
-} {~: foo}
-test filename-5.17 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ~/foo
-} {~: foo}
-test filename-5.18 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ~foo:
-} {~foo:}
-test filename-5.19 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split a:~foo
-} {a: :~foo}
-test filename-5.20 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split /
-} {:/}
-test filename-5.21 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split a:b/c
-} {a: :b/c}
-test filename-5.22 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split /foo
-} {foo:}
-test filename-5.23 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split /a/b
-} {a: b}
-test filename-5.24 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split /a/b/foo
-} {a: b foo}
-test filename-5.25 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split a/b
-} {a b}
-test filename-5.26 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ./foo/bar
-} {: foo bar}
-test filename-5.27 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ../foo/bar
-} {:: foo bar}
-test filename-5.28 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split {}
-} {}
-test filename-5.29 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split .
-} {:}
-test filename-5.30 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ././
-} {: :}
-test filename-5.31 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ././.
-} {: : :}
-test filename-5.32 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ../
-} {::}
-test filename-5.33 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ..
-} {::}
-test filename-5.34 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ../..
-} {:: ::}
-test filename-5.35 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split //foo
-} {foo:}
-test filename-5.36 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split foo//bar
-} {foo bar}
-test filename-5.37 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ~foo
-} {~foo:}
-test filename-5.38 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ~
-} {~:}
-test filename-5.39 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split foo
-} {foo}
-test filename-5.40 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ~/
-} {~:}
-test filename-5.41 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ~foo/~bar
-} {~foo: :~bar}
-test filename-5.42 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split ~foo/~bar/~baz
-} {~foo: :~bar :~baz}
-test filename-5.43 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split foo/bar~/baz
-} {foo bar~ baz}
-test filename-5.44 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split a/../b
-} {a :: b}
-test filename-5.45 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split a/../../b
-} {a :: :: b}
-test filename-5.46 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split a/.././../b
-} {a :: : :: b}
-test filename-5.47 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split /../bar
-} {bar:}
-test filename-5.48 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split /./bar
-} {bar:}
-test filename-5.49 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split //.//.././bar
-} {bar:}
-test filename-5.50 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split /..
-} {:/..}
-test filename-5.51 {Tcl_SplitPath: mac} {testsetplatform} {
- testsetplatform mac
- file split //.//.././
-} {://.//.././}
-
-test filename-6.1 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split /
-} {/}
-test filename-6.2 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split /foo
-} {/ foo}
-test filename-6.3 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split /foo/bar
-} {/ foo bar}
-test filename-6.4 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split /foo/bar/baz
-} {/ foo bar baz}
-test filename-6.5 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split foo/bar
-} {foo bar}
-test filename-6.6 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split ./foo/bar
-} {. foo bar}
-test filename-6.7 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split /foo/../././foo/bar
-} {/ foo .. . . foo bar}
-test filename-6.8 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split ../foo/bar
-} {.. foo bar}
-test filename-6.9 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split {}
-} {}
-test filename-6.10 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split .
-} {.}
-test filename-6.11 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split ../
-} {..}
-test filename-6.12 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split ../..
-} {.. ..}
-test filename-6.13 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split //foo
-} {/ foo}
-test filename-6.14 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split foo//bar
-} {foo bar}
-test filename-6.15 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split /\\/foo//bar
-} {//foo/bar}
-test filename-6.16 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split /\\/foo//bar
-} {//foo/bar}
-test filename-6.17 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split /\\/foo//bar
-} {//foo/bar}
-test filename-6.18 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split \\\\foo\\bar
-} {//foo/bar}
-test filename-6.19 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split \\\\foo\\bar/baz
-} {//foo/bar baz}
-test filename-6.20 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split c:/foo
-} {c:/ foo}
-test filename-6.21 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split c:foo
-} {c: foo}
-test filename-6.22 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split c:
-} {c:}
-test filename-6.23 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split c:\\
-} {c:/}
-test filename-6.24 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split c:/
-} {c:/}
-test filename-6.25 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split c:/./..
-} {c:/ . ..}
-test filename-6.26 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split ~foo
-} {~foo}
-test filename-6.27 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split ~foo/~bar
-} {~foo ./~bar}
-test filename-6.28 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split ~foo/~bar/~baz
-} {~foo ./~bar ./~baz}
-test filename-6.29 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split foo/bar~/baz
-} {foo bar~ baz}
-test filename-6.30 {Tcl_SplitPath: win} {testsetplatform} {
- testsetplatform win
- file split c:~foo
-} {c: ./~foo}
-
-test filename-7.1 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join / a
-} {/a}
-test filename-7.2 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join a b
-} {a/b}
-test filename-7.3 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join /a c /b d
-} {/b/d}
-test filename-7.4 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join /
-} {/}
-test filename-7.5 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join a
-} {a}
-test filename-7.6 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join {}
-} {}
-test filename-7.7 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join /a/ b
-} {/a/b}
-test filename-7.8 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join /a// b
-} {/a/b}
-test filename-7.9 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join /a/./../. b
-} {/a/./.././b}
-test filename-7.10 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join ~ a
-} {~/a}
-test filename-7.11 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join ~a ~b
-} {~b}
-test filename-7.12 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join ./~a b
-} {./~a/b}
-test filename-7.13 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join ./~a ~b
-} {~b}
-test filename-7.14 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join ./~a ./~b
-} {./~a/~b}
-test filename-7.15 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join a . b
-} {a/./b}
-test filename-7.16 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join a . ./~b
-} {a/./~b}
-test filename-7.17 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join //a b
-} {/a/b}
-test filename-7.18 {Tcl_JoinPath: unix} {testsetplatform} {
- testsetplatform unix
- file join /// a b
-} {/a/b}
-
-test filename-8.1 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join a b
-} {:a:b}
-test filename-8.2 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join :a b
-} {:a:b}
-test filename-8.3 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join a b:
-} {b:}
-test filename-8.4 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join a: :b
-} {a:b}
-test filename-8.5 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join a: :b:
-} {a:b}
-test filename-8.6 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join a :: b
-} {:a::b}
-test filename-8.7 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join a :: :: b
-} {:a:::b}
-test filename-8.8 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join a ::: b
-} {:a:::b}
-test filename-8.9 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join a: b:
-} {b:}
-test filename-8.10 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join /a/b
-} {a:b}
-test filename-8.11 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join /a/b c/d
-} {a:b:c:d}
-test filename-8.12 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join /a/b :c:d
-} {a:b:c:d}
-test filename-8.13 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join ~ foo
-} {~:foo}
-test filename-8.14 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join :: ::
-} {:::}
-test filename-8.15 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join a: ::
-} {a::}
-test filename-8.16 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join a {} b
-} {:a:b}
-test filename-8.17 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join a::: b
-} {a:::b}
-test filename-8.18 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join a : : :
-} {:a}
-test filename-8.19 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join :
-} {:}
-test filename-8.20 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join : a
-} {:a}
-test filename-8.21 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join a: :b/c
-} {a:b/c}
-test filename-8.22 {Tcl_JoinPath: mac} {testsetplatform} {
- testsetplatform mac
- file join :a :b/c
-} {:a:b/c}
-
-test filename-9.1 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join a b
-} {a/b}
-test filename-9.2 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join /a b
-} {/a/b}
-test filename-9.3 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join /a /b
-} {/b}
-test filename-9.4 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join c: foo
-} {c:foo}
-test filename-9.5 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join c:/ foo
-} {c:/foo}
-test filename-9.6 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join c:\\bar foo
-} {c:/bar/foo}
-test filename-9.7 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join /foo c:bar
-} {c:bar}
-test filename-9.8 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join ///host//share dir
-} {//host/share/dir}
-test filename-9.9 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join ~ foo
-} {~/foo}
-test filename-9.10 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join ~/~foo
-} {~/~foo}
-test filename-9.11 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join ~ ./~foo
-} {~/~foo}
-test filename-9.12 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join / ~foo
-} {~foo}
-test filename-9.13 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join ./a/ b c
-} {./a/b/c}
-test filename-9.14 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join ./~a/ b c
-} {./~a/b/c}
-test filename-9.15 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join // host share path
-} {/host/share/path}
-test filename-9.16 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join foo . bar
-} {foo/./bar}
-test filename-9.17 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join foo .. bar
-} {foo/../bar}
-test filename-9.18 {Tcl_JoinPath: win} {testsetplatform} {
- testsetplatform win
- file join foo/./bar
-} {foo/./bar}
-
-test filename-10.1 {Tcl_TranslateFileName} {testsetplatform} {
- testsetplatform unix
- list [catch {testtranslatefilename foo} msg] $msg
-} {0 foo}
-test filename-10.2 {Tcl_TranslateFileName} {testsetplatform} {
- testsetplatform windows
- list [catch {testtranslatefilename {c:/foo}} msg] $msg
-} {0 {c:\foo}}
-test filename-10.3 {Tcl_TranslateFileName} {testsetplatform} {
- testsetplatform windows
- list [catch {testtranslatefilename {c:/\\foo/}} msg] $msg
-} {0 {c:\foo}}
-test filename-10.4 {Tcl_TranslateFileName} {testsetplatform} {
- testsetplatform mac
- list [catch {testtranslatefilename foo} msg] $msg
-} {0 :foo}
-test filename-10.5 {Tcl_TranslateFileName} {testsetplatform} {
- testsetplatform mac
- list [catch {testtranslatefilename :~foo} msg] $msg
-} {0 :~foo}
-test filename-10.6 {Tcl_TranslateFileName} {testsetplatform} {
- global env
- set temp $env(HOME)
- set env(HOME) "/home/test"
- testsetplatform unix
- set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 /home/test/foo}
-test filename-10.7 {Tcl_TranslateFileName} {testsetplatform} {
- global env
- set temp $env(HOME)
- unset env(HOME)
- testsetplatform unix
- set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
- set env(HOME) $temp
- set result
-} {1 {couldn't find HOME environment variable to expand path}}
-test filename-10.8 {Tcl_TranslateFileName} {testsetplatform} {
- global env
- set temp $env(HOME)
- set env(HOME) "/home/test"
- testsetplatform unix
- set result [list [catch {testtranslatefilename ~} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 /home/test}
-test filename-10.9 {Tcl_TranslateFileName} {testsetplatform} {
- global env
- set temp $env(HOME)
- set env(HOME) "/home/test/"
- testsetplatform unix
- set result [list [catch {testtranslatefilename ~} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 /home/test}
-test filename-10.10 {Tcl_TranslateFileName} {testsetplatform} {
- global env
- set temp $env(HOME)
- set env(HOME) "/home/test/"
- testsetplatform unix
- set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 /home/test/foo}
-test filename-10.11 {Tcl_TranslateFileName} {testsetplatform} {
- global env
- set temp $env(HOME)
- set env(HOME) "Root:"
- testsetplatform mac
- set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 Root:foo}
-test filename-10.12 {Tcl_TranslateFileName} {testsetplatform} {
- global env
- set temp $env(HOME)
- set env(HOME) "Root:home"
- testsetplatform mac
- set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 Root:home:foo}
-test filename-10.13 {Tcl_TranslateFileName} {testsetplatform} {
- global env
- set temp $env(HOME)
- set env(HOME) "Root:home"
- testsetplatform mac
- set result [list [catch {testtranslatefilename ~::foo} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 Root:home::foo}
-test filename-10.14 {Tcl_TranslateFileName} {testsetplatform} {
- global env
- set temp $env(HOME)
- set env(HOME) "Root:home"
- testsetplatform mac
- set result [list [catch {testtranslatefilename ~} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 Root:home}
-test filename-10.15 {Tcl_TranslateFileName} {testsetplatform} {
- global env
- set temp $env(HOME)
- set env(HOME) "Root:home:"
- testsetplatform mac
- set result [list [catch {testtranslatefilename ~::foo} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 Root:home::foo}
-test filename-10.16 {Tcl_TranslateFileName} {testsetplatform} {
- global env
- set temp $env(HOME)
- set env(HOME) "Root:home::"
- testsetplatform mac
- set result [list [catch {testtranslatefilename ~::foo} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 Root:home:::foo}
-test filename-10.17 {Tcl_TranslateFileName} {testsetplatform} {
- global env
- set temp $env(HOME)
- set env(HOME) "\\home\\"
- testsetplatform windows
- set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 {\home\foo}}
-test filename-10.18 {Tcl_TranslateFileName} {testsetplatform} {
- global env
- set temp $env(HOME)
- set env(HOME) "\\home\\"
- testsetplatform windows
- set result [list [catch {testtranslatefilename ~/foo\\bar} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 {\home\foo\bar}}
-test filename-10.19 {Tcl_TranslateFileName} {testsetplatform} {
- global env
- set temp $env(HOME)
- set env(HOME) "c:"
- testsetplatform windows
- set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 c:foo}
-test filename-10.20 {Tcl_TranslateFileName} {testtranslatefilename} {
- list [catch {testtranslatefilename ~blorp/foo} msg] $msg
-} {1 {user "blorp" doesn't exist}}
-test filename-10.21 {Tcl_TranslateFileName} {testsetplatform} {
- global env
- set temp $env(HOME)
- set env(HOME) "c:\\"
- testsetplatform windows
- set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
- set env(HOME) $temp
- set result
-} {0 {c:\foo}}
-test filename-10.22 {Tcl_TranslateFileName} {testsetplatform} {
- testsetplatform windows
- list [catch {testtranslatefilename foo//bar} msg] $msg
-} {0 {foo\bar}}
-
-if {[tcltest::testConstraint testsetplatform]} {
- testsetplatform $platform
-}
-
-test filename-10.23 {Tcl_TranslateFileName} {unixOnly nonPortable} {
- # this test fails if ~ouster is not /home/ouster
- list [catch {testtranslatefilename ~ouster} msg] $msg
-} {0 /home/ouster}
-test filename-10.24 {Tcl_TranslateFileName} {unixOnly nonPortable} {
- # this test fails if ~ouster is not /home/ouster
- list [catch {testtranslatefilename ~ouster/foo} msg] $msg
-} {0 /home/ouster/foo}
-
-
-test filename-11.1 {Tcl_GlobCmd} {
- list [catch {glob} msg] $msg
-} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
-test filename-11.2 {Tcl_GlobCmd} {
- list [catch {glob -gorp} msg] $msg
-} {1 {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}}
-test filename-11.3 {Tcl_GlobCmd} {
- list [catch {glob -nocomplai} msg] $msg
-} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
-test filename-11.4 {Tcl_GlobCmd} {
- list [catch {glob -nocomplain} msg] $msg
-} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
-test filename-11.5 {Tcl_GlobCmd} {
- list [catch {glob -nocomplain ~xyqrszzz} msg] $msg
-} {0 {}}
-test filename-11.6 {Tcl_GlobCmd} {
- list [catch {glob ~xyqrszzz} msg] $msg
-} {1 {user "xyqrszzz" doesn't exist}}
-test filename-11.7 {Tcl_GlobCmd} {
- list [catch {glob -- -nocomplain} msg] $msg
-} {1 {no files matched glob pattern "-nocomplain"}}
-test filename-11.8 {Tcl_GlobCmd} {
- list [catch {glob -nocomplain -- -nocomplain} msg] $msg
-} {0 {}}
-test filename-11.9 {Tcl_GlobCmd} {testsetplatform} {
- testsetplatform unix
- list [catch {glob ~\\xyqrszzz/bar} msg] $msg
-} {1 {user "\xyqrszzz" doesn't exist}}
-test filename-11.10 {Tcl_GlobCmd} {testsetplatform} {
- testsetplatform unix
- list [catch {glob -nocomplain ~\\xyqrszzz/bar} msg] $msg
-} {0 {}}
-test filename-11.11 {Tcl_GlobCmd} {testsetplatform} {
- testsetplatform unix
- list [catch {glob ~xyqrszzz\\/\\bar} msg] $msg
-} {1 {user "xyqrszzz" doesn't exist}}
-test filename-11.12 {Tcl_GlobCmd} {testsetplatform} {
- testsetplatform unix
- set home $env(HOME)
- unset env(HOME)
- set x [list [catch {glob ~/*} msg] $msg]
- set env(HOME) $home
- set x
-} {1 {couldn't find HOME environment variable to expand path}}
-
-if {[tcltest::testConstraint testsetplatform]} {
- testsetplatform $platform
-}
-
-test filename-11.13 {Tcl_GlobCmd} {
- list [catch {file join [lindex [glob ~] 0]} msg] $msg
-} [list 0 [file join $env(HOME)]]
-
-set oldhome $env(HOME)
-set env(HOME) [pwd]
-file delete -force globTest
-file mkdir globTest/a1/b1
-file mkdir globTest/a1/b2
-file mkdir globTest/a2/b3
-file mkdir globTest/a3
-close [open globTest/x1.c w]
-close [open globTest/y1.c w]
-close [open globTest/z1.c w]
-close [open "globTest/weird name.c" w]
-close [open globTest/a1/b1/x2.c w]
-close [open globTest/a1/b2/y2.c w]
-
-catch {close [open globTest/.1 w]}
-catch {close [open globTest/x,z1.c w]}
-
-test filename-11.14 {Tcl_GlobCmd} {
- list [catch {glob ~/globTest} msg] $msg
-} [list 0 [list [file join $env(HOME) globTest]]]
-test filename-11.15 {Tcl_GlobCmd} {
- list [catch {glob ~\\/globTest} msg] $msg
-} [list 0 [list [file join $env(HOME) globTest]]]
-test filename-11.16 {Tcl_GlobCmd} {
- list [catch {glob globTest} msg] $msg
-} {0 globTest}
-
-set globname "globTest"
-set horribleglobname "glob\[\{Test"
-
-test filename-11.17 {Tcl_GlobCmd} {unixOnly} {
- list [catch {lsort [glob -directory $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname a3]\
- [file join $globname "weird name.c"]\
- [file join $globname x,z1.c]\
- [file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-11.17.1 {Tcl_GlobCmd} {pcOnly macOnly} {
- list [catch {lsort [glob -directory $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname .1]\
- [file join $globname a3]\
- [file join $globname "weird name.c"]\
- [file join $globname x,z1.c]\
- [file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-11.18 {Tcl_GlobCmd} {unixOnly} {
- list [catch {lsort [glob -path $globname/ *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname a3]\
- [file join $globname "weird name.c"]\
- [file join $globname x,z1.c]\
- [file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-11.18.1 {Tcl_GlobCmd} {pcOnly macOnly} {
- list [catch {lsort [glob -path $globname/ *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname .1]\
- [file join $globname a3]\
- [file join $globname "weird name.c"]\
- [file join $globname x,z1.c]\
- [file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-11.19 {Tcl_GlobCmd} {unixOnly} {
- list [catch {lsort [glob -join -path \
- [string range $globname 0 5] * *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname a3]\
- [file join $globname "weird name.c"]\
- [file join $globname x,z1.c]\
- [file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-11.19.1 {Tcl_GlobCmd} {pcOnly macOnly} {
- list [catch {lsort [glob -join -path \
- [string range $globname 0 5] * *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname .1]\
- [file join $globname a3]\
- [file join $globname "weird name.c"]\
- [file join $globname x,z1.c]\
- [file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-11.20 {Tcl_GlobCmd} {
- list [catch {lsort [glob -type d -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1]\
- [file join $globname a2]\
- [file join $globname a3]]]]
-test filename-11.21 {Tcl_GlobCmd} {
- list [catch {lsort [glob -type d -path $globname *]} msg] $msg
-} [list 0 [lsort [list $globname]]]
-
-file rename globTest $horribleglobname
-set globname $horribleglobname
-
-test filename-11.22 {Tcl_GlobCmd} {unixOnly} {
- list [catch {lsort [glob -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname a3]\
- [file join $globname "weird name.c"]\
- [file join $globname x,z1.c]\
- [file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-11.22.1 {Tcl_GlobCmd} {pcOnly macOnly} {
- list [catch {lsort [glob -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname .1]\
- [file join $globname a3]\
- [file join $globname "weird name.c"]\
- [file join $globname x,z1.c]\
- [file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-11.23 {Tcl_GlobCmd} {unixOnly} {
- list [catch {lsort [glob -path $globname/ *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname a3]\
- [file join $globname "weird name.c"]\
- [file join $globname x,z1.c]\
- [file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-11.23.1 {Tcl_GlobCmd} {pcOnly macOnly} {
- list [catch {lsort [glob -path $globname/ *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname .1]\
- [file join $globname a3]\
- [file join $globname "weird name.c"]\
- [file join $globname x,z1.c]\
- [file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-11.24 {Tcl_GlobCmd} {unixOnly} {
- list [catch {lsort [glob -join -path \
- [string range $globname 0 5] * *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname a3]\
- [file join $globname "weird name.c"]\
- [file join $globname x,z1.c]\
- [file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-11.24.1 {Tcl_GlobCmd} {pcOnly macOnly} {
- list [catch {lsort [glob -join -path \
- [string range $globname 0 5] * *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
- [file join $globname .1]\
- [file join $globname a3]\
- [file join $globname "weird name.c"]\
- [file join $globname x,z1.c]\
- [file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-11.25 {Tcl_GlobCmd} {
- list [catch {lsort [glob -type d -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1]\
- [file join $globname a2]\
- [file join $globname a3]]]]
-test filename-11.26 {Tcl_GlobCmd} {
- list [catch {glob -type d -path $globname *} msg] $msg
-} [list 0 [list $globname]]
-test filename-11.27 {Tcl_GlobCmd} {
- list [catch {glob -types abcde *} msg] $msg
-} {1 {bad argument to "-types": abcde}}
-test filename-11.28 {Tcl_GlobCmd} {
- list [catch {glob -types z *} msg] $msg
-} {1 {bad argument to "-types": z}}
-test filename-11.29 {Tcl_GlobCmd} {
- list [catch {glob -types {abcd efgh} *} msg] $msg
-} {1 {only one MacOS type or creator argument to "-types" allowed}}
-test filename-11.30 {Tcl_GlobCmd} {
- list [catch {glob -types {{macintosh type TEXT} \
- {macintosh creator ALFA} efgh} *} msg] $msg
-} {1 {only one MacOS type or creator argument to "-types" allowed}}
-test filename-11.31 {Tcl_GlobCmd} {
- list [catch {glob -types} msg] $msg
-} {1 {missing argument to "-types"}}
-test filename-11.32 {Tcl_GlobCmd} {
- list [catch {glob -path hello -dir hello *} msg] $msg
-} {1 {"-directory" cannot be used with "-path"}}
-test filename-11.33 {Tcl_GlobCmd} {
- list [catch {glob -path} msg] $msg
-} {1 {missing argument to "-path"}}
-test filename-11.34 {Tcl_GlobCmd} {
- list [catch {glob -direct} msg] $msg
-} {1 {missing argument to "-directory"}}
-test filename-11.35 {Tcl_GlobCmd} {
- list [catch {glob -paths *} msg] $msg
-} {1 {bad option "-paths": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}}
-
-file rename $horribleglobname globTest
-set globname globTest
-unset horribleglobname
-
-test filename-12.1 {simple globbing} {unixOrPc} {
- list [catch {glob {}} msg] $msg
-} {0 .}
-test filename-12.2 {simple globbing} {macOnly} {
- list [catch {glob {}} msg] $msg
-} {0 :}
-test filename-12.3 {simple globbing} {
- list [catch {glob -nocomplain \{a1,a2\}} msg] $msg
-} {0 {}}
-
-if {$tcl_platform(platform) == "macintosh"} {
- set globPreResult :globTest:
-} else {
- set globPreResult globTest/
-}
-set x1 x1.c
-set y1 y1.c
-test filename-12.4 {simple globbing} {unixOrPc} {
- lsort [glob globTest/x1.c globTest/y1.c globTest/foo]
-} "$globPreResult$x1 $globPreResult$y1"
-test filename-12.5 {simple globbing} {
- list [catch {glob globTest\\/x1.c} msg] $msg
-} "0 $globPreResult$x1"
-test filename-12.6 {simple globbing} {
- list [catch {glob globTest\\/\\x1.c} msg] $msg
-} "0 $globPreResult$x1"
-
-test filename-13.1 {globbing with brace substitution} {
- list [catch {glob globTest/\{\}} msg] $msg
-} "0 $globPreResult"
-test filename-13.2 {globbing with brace substitution} {
- list [catch {glob globTest/\{} msg] $msg
-} {1 {unmatched open-brace in file name}}
-test filename-13.3 {globbing with brace substitution} {
- list [catch {glob globTest/\{\\\}} msg] $msg
-} {1 {unmatched open-brace in file name}}
-test filename-13.4 {globbing with brace substitution} {
- list [catch {glob globTest/\{\\} msg] $msg
-} {1 {unmatched open-brace in file name}}
-test filename-13.5 {globbing with brace substitution} {
- list [catch {glob globTest/\}} msg] $msg
-} {1 {unmatched close-brace in file name}}
-test filename-13.6 {globbing with brace substitution} {
- list [catch {glob globTest/\{\}x1.c} msg] $msg
-} "0 $globPreResult$x1"
-test filename-13.7 {globbing with brace substitution} {
- list [catch {glob globTest/\{x\}1.c} msg] $msg
-} "0 $globPreResult$x1"
-test filename-13.8 {globbing with brace substitution} {
- list [catch {glob globTest/\{x\{\}\}1.c} msg] $msg
-} "0 $globPreResult$x1"
-test filename-13.9 {globbing with brace substitution} {
- list [lsort [catch {glob globTest/\{x,y\}1.c} msg]] $msg
-} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
-test filename-13.10 {globbing with brace substitution} {
- list [lsort [catch {glob globTest/\{x,,y\}1.c} msg]] $msg
-} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
-test filename-13.11 {globbing with brace substitution} {unixOrPc} {
- list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg
-} {0 {globTest/x1.c globTest/x,z1.c globTest/z1.c}}
-test filename-13.12 {globbing with brace substitution} {macOnly} {
- list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg
-} {0 {:globTest:x1.c :globTest:x,z1.c :globTest:z1.c}}
-test filename-13.13 {globbing with brace substitution} {
- lsort [glob globTest/{a,b,x,y}1.c]
-} [list $globPreResult$x1 $globPreResult$y1]
-test filename-13.14 {globbing with brace substitution} {unixOrPc} {
- lsort [glob {globTest/{x1,y2,weird name}.c}]
-} {{globTest/weird name.c} globTest/x1.c}
-test filename-13.15 {globbing with brace substitution} {macOnly} {
- lsort [glob {globTest/{x1,y2,weird name}.c}]
-} {{:globTest:weird name.c} :globTest:x1.c}
-test filename-13.16 {globbing with brace substitution} {unixOrPc} {
- lsort [glob globTest/{x1.c,a1/*}]
-} {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
-test filename-13.17 {globbing with brace substitution} {macOnly} {
- lsort [glob globTest/{x1.c,a1/*}]
-} {:globTest:a1:b1 :globTest:a1:b2 :globTest:x1.c}
-test filename-13.18 {globbing with brace substitution} {unixOrPc} {
- lsort [glob globTest/{x1.c,{a},a1/*}]
-} {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
-test filename-13.19 {globbing with brace substitution} {macOnly} {
- lsort [glob globTest/{x1.c,{a},a1/*}]
-} {:globTest:a1:b1 :globTest:a1:b2 :globTest:x1.c}
-test filename-13.20 {globbing with brace substitution} {unixOrPc} {
- lsort [glob globTest/{a,x}1/*/{x,y}*]
-} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
-test filename-13.21 {globbing with brace substitution} {macOnly} {
- lsort [glob globTest/{a,x}1/*/{x,y}*]
-} {:globTest:a1:b1:x2.c :globTest:a1:b2:y2.c}
-test filename-13.22 {globbing with brace substitution} {
- list [catch {glob globTest/\{a,x\}1/*/\{} msg] $msg
-} {1 {unmatched open-brace in file name}}
-
-test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} {
- lsort [glob glo*/*.c]
-} {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
-test filename-14.2 {asterisks, question marks, and brackets} {macOnly} {
- lsort [glob glo*/*.c]
-} {{:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c}
-test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} {
- lsort [glob globTest/?1.c]
-} {globTest/x1.c globTest/y1.c globTest/z1.c}
-test filename-14.4 {asterisks, question marks, and brackets} {macOnly} {
- lsort [glob globTest/?1.c]
-} {:globTest:x1.c :globTest:y1.c :globTest:z1.c}
-test filename-14.5 {asterisks, question marks, and brackets} {unixOrPc} {
- lsort [glob */*/*/*.c]
-} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
-test filename-14.6 {asterisks, question marks, and brackets} {macOnly} {
- lsort [glob */*/*/*.c]
-} {:globTest:a1:b1:x2.c :globTest:a1:b2:y2.c}
-test filename-14.7 {asterisks, question marks, and brackets} {unixOnly} {
- lsort [glob globTest/*]
-} {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
-test filename-14.7.1 {asterisks, question marks, and brackets} {pcOnly} {
- lsort [glob globTest/*]
-} {globTest/.1 globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
-test filename-14.8 {asterisks, question marks, and brackets} {macOnly} {
- lsort [glob globTest/*]
-} {:globTest:.1 :globTest:a1 :globTest:a2 :globTest:a3 {:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c}
-test filename-14.9 {asterisks, question marks, and brackets} {unixOrPc} {
- lsort [glob globTest/.*]
-} {globTest/. globTest/.. globTest/.1}
-test filename-14.10 {asterisks, question marks, and brackets} {macOnly} {
- lsort [glob globTest/.*]
-} {:globTest:.1}
-test filename-14.11 {asterisks, question marks, and brackets} {unixOrPc} {
- lsort [glob globTest/*/*]
-} {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3}
-test filename-14.12 {asterisks, question marks, and brackets} {macOnly} {
- lsort [glob globTest/*/*]
-} {:globTest:a1:b1 :globTest:a1:b2 :globTest:a2:b3}
-test filename-14.13 {asterisks, question marks, and brackets} {unixOrPc} {
- lsort [glob {globTest/[xyab]1.*}]
-} {globTest/x1.c globTest/y1.c}
-test filename-14.14 {asterisks, question marks, and brackets} {macOnly} {
- lsort [glob {globTest/[xyab]1.*}]
-} {:globTest:x1.c :globTest:y1.c}
-test filename-14.15 {asterisks, question marks, and brackets} {unixOrPc} {
- lsort [glob globTest/*/]
-} {globTest/a1/ globTest/a2/ globTest/a3/}
-test filename-14.16 {asterisks, question marks, and brackets} {macOnly} {
- lsort [glob globTest/*/]
-} {:globTest:a1: :globTest:a2: :globTest:a3:}
-test filename-14.17 {asterisks, question marks, and brackets} {
- global env
- set temp $env(HOME)
- set env(HOME) [file join $env(HOME) globTest]
- set result [list [catch {glob ~/z*} msg] $msg]
- set env(HOME) $temp
- set result
-} [list 0 [list [file join $env(HOME) globTest z1.c]]]
-test filename-14.18 {asterisks, question marks, and brackets} {unixOrPc} {
- list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg
-} {0 {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}}
-test filename-14.19 {asterisks, question marks, and brackets} {macOnly} {
- list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg
-} {0 {{:globTest:weird name.c} :globTest:x,z1.c :globTest:x1.c :globTest:y1.c :globTest:z1.c}}
-test filename-14.20 {asterisks, question marks, and brackets} {
- list [catch {glob -nocomplain goo/*} msg] $msg
-} {0 {}}
-test filename-14.21 {asterisks, question marks, and brackets} {
- list [catch {glob globTest/*/gorp} msg] $msg
-} {1 {no files matched glob pattern "globTest/*/gorp"}}
-test filename-14.22 {asterisks, question marks, and brackets} {
- list [catch {glob goo/* x*z foo?q} msg] $msg
-} {1 {no files matched glob patterns "goo/* x*z foo?q"}}
-test filename-14.23 {slash globbing} {unixOrPc} {
- glob /
-} /
-test filename-14.24 {slash globbing} {pcOnly} {
- glob {\\}
-} /
-test filename-14.25 {type specific globbing} {unixOnly} {
- list [catch {lsort [glob -dir globTest -types f *]} msg] $msg
-} [list 0 [lsort [list \
- [file join $globname "weird name.c"]\
- [file join $globname x,z1.c]\
- [file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-14.25.1 {type specific globbing} {pcOnly macOnly} {
- list [catch {lsort [glob -dir globTest -types f *]} msg] $msg
-} [list 0 [lsort [list \
- [file join $globname .1]\
- [file join $globname "weird name.c"]\
- [file join $globname x,z1.c]\
- [file join $globname x1.c]\
- [file join $globname y1.c] [file join $globname z1.c]]]]
-test filename-14.26 {type specific globbing} {
- list [catch {glob -nocomplain -dir globTest -types {readonly} *} msg] $msg
-} [list 0 {}]
-
-unset globname
-
-# The following tests are only valid for Unix systems.
-# On some systems, like AFS, "000" protection doesn't prevent
-# access by owner, so the following test is not portable.
-
-catch {exec chmod 000 globTest/a1}
-test filename-15.1 {unix specific globbing} {unixOnly nonPortable} {
- string tolower [list [catch {glob globTest/a1/*} msg] $msg $errorCode]
-} {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}}
-test filename-15.2 {unix specific no complain: no errors} {unixOnly nonPortable} {
- glob -nocomplain globTest/a1/*
-} {}
-test filename-15.3 {unix specific no complain: no errors, good result} \
- {unixOnly nonPortable knownBug} {
- # test fails because if an error occur , the interp's result
- # is reset...
- glob -nocomplain globTest/a2 globTest/a1/* globTest/a3
-} {globTest/a2 globTest/a3}
-
-catch {exec chmod 755 globTest/a1}
-test filename-15.4 {unix specific no complain: no errors, good result} \
- {unixOnly nonPortable knownBug} {
- # test fails because if an error occurs, the interp's result
- # is reset... or you don't run at scriptics where the
- # outser and welch users exists
- glob -nocomplain ~ouster ~foo ~welch
-} {/home/ouster /home/welch}
-test filename-15.5 {unix specific globbing} {unixOnly nonPortable} {
- glob ~ouster/.csh*
-} "/home/ouster/.cshrc"
-catch {close [open globTest/odd\\\[\]*?\{\}name w]}
-test filename-15.6 {unix specific globbing} {unixOnly} {
- global env
- set temp $env(HOME)
- set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name
- set result [list [catch {glob ~} msg] $msg]
- set env(HOME) $temp
- set result
-} [list 0 [list [glob ~]/globTest/odd\\\[\]*?\{\}name]]
-catch {exec rm -f globTest/odd\\\[\]*?\{\}name}
-
-# The following tests are only valid for Windows systems.
-set oldDir [pwd]
-if {$::tcltest::testConstraints(pcOnly)} {
- cd c:/
- file delete -force globTest
- file mkdir globTest
- close [open globTest/x1.BAT w]
- close [open globTest/y1.Bat w]
- close [open globTest/z1.bat w]
-}
-
-test filename-16.1 {windows specific globbing} {pcOnly} {
- lsort [glob globTest/*.bat]
-} {globTest/x1.BAT globTest/y1.Bat globTest/z1.bat}
-test filename-16.2 {windows specific globbing} {pcOnly} {
- glob c:
-} c:
-test filename-16.3 {windows specific globbing} {pcOnly} {
- glob c:\\\\
-} c:/
-test filename-16.4 {windows specific globbing} {pcOnly} {
- glob c:/
-} c:/
-test filename-16.5 {windows specific globbing} {pcOnly} {
- glob c:*Test
-} c:globTest
-test filename-16.6 {windows specific globbing} {pcOnly} {
- glob c:\\\\*Test
-} c:/globTest
-test filename-16.7 {windows specific globbing} {pcOnly} {
- glob c:/*Test
-} c:/globTest
-test filename-16.8 {windows specific globbing} {pcOnly} {
- lsort [glob c:globTest/*.bat]
-} {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
-test filename-16.9 {windows specific globbing} {pcOnly} {
- lsort [glob c:/globTest/*.bat]
-} {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
-test filename-16.10 {windows specific globbing} {pcOnly} {
- lsort [glob c:globTest\\\\*.bat]
-} {c:globTest/x1.BAT c:globTest/y1.Bat c:globTest/z1.bat}
-test filename-16.11 {windows specific globbing} {pcOnly} {
- lsort [glob c:\\\\globTest\\\\*.bat]
-} {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
-
-# some tests require a shared C drive
-
-if {[catch {cd //[info hostname]/c}]} {
- set ::tcltest::testConstraints(sharedCdrive) 0
-} else {
- set ::tcltest::testConstraints(sharedCdrive) 1
-}
-
-test filename-16.12 {windows specific globbing} {pcOnly sharedCdrive} {
- cd //[info hostname]/c
- glob //[info hostname]/c/*Test
-} //[info hostname]/c/globTest
-test filename-16.13 {windows specific globbing} {pcOnly sharedCdrive} {
- cd //[info hostname]/c
- glob "\\\\\\\\[info hostname]\\\\c\\\\*Test"
-} //[info hostname]/c/globTest
-
-# cleanup
-file delete -force C:/globTest
-cd $oldDir
-file delete -force globTest
-set env(HOME) $oldhome
-if {[tcltest::testConstraint testsetplatform]} {
- testsetplatform $platform
- catch {unset platform}
-}
-catch {unset oldhome temp result}
-::tcltest::cleanupTests
-return
+++ /dev/null
-# This file tests the tclfCmd.c file.
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
-#
-# Copyright (c) 1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id$
-#
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-catch {file delete -force foo.dir}
-file mkdir foo.dir
-if {[catch {file attributes foo.dir -readonly 1}]} {
- set ::tcltest::testConstraints(fileSharing) 0
- set ::tcltest::testConstraints(notFileSharing) 1
-} else {
- set ::tcltest::testConstraints(fileSharing) 1
- set ::tcltest::testConstraints(notFileSharing) 0
-}
-file delete -force foo.dir
-
-test macFCmd-1.1 {GetFileFinderAttributes - no file} {macOnly} {
- catch {file delete -force foo.file}
- list [catch {file attributes foo.file -creator} msg] $msg
-} {1 {could not read ":foo.file": no such file or directory}}
-test macFCmd-1.2 {GetFileFinderAttributes - creator} {macOnly} {
- catch {file delete -force foo.file}
- catch {close [open foo.file w]}
- list [catch {file attributes foo.file -creator} msg] $msg \
- [file delete -force foo.file]
-} {0 {MPW } {}}
-test macFCmd-1.3 {GetFileFinderAttributes - type} {macOnly} {
- catch {file delete -force foo.file}
- catch {close [open foo.file w]}
- list [catch {file attributes foo.file -type} msg] $msg \
- [file delete -force foo.file]
-} {0 TEXT {}}
-test macFCmd-1.4 {GetFileFinderAttributes - not hidden} {macOnly} {
- catch {file delete -force foo.file}
- catch {close [open foo.file w]}
- list [catch {file attributes foo.file -hidden} msg] $msg \
- [file delete -force foo.file]
-} {0 0 {}}
-test macFCmd-1.5 {GetFileFinderAttributes - hidden} {macOnly} {
- catch {file delete -force foo.file}
- catch {close [open foo.file w]}
- file attributes foo.file -hidden 1
- list [catch {file attributes foo.file -hidden} msg] $msg \
- [file delete -force foo.file]
-} {0 1 {}}
-test macFCmd-1.6 {GetFileFinderAttributes - folder creator} {macOnly} {
- catch {file delete -force foo.dir}
- file mkdir foo.dir
- list [catch {file attributes foo.dir -creator} msg] $msg \
- [file delete -force foo.dir]
-} {0 Fldr {}}
-test macFCmd-1.7 {GetFileFinderAttributes - folder type} {macOnly} {
- catch {file delete -force foo.dir}
- file mkdir foo.dir
- list [catch {file attributes foo.dir -type} msg] $msg \
- [file delete -force foo.dir]
-} {0 Fldr {}}
-test macFCmd-1.8 {GetFileFinderAttributes - folder hidden} {macOnly} {
- catch {file delete -force foo.dir}
- file mkdir foo.dir
- list [catch {file attributes foo.dir -hidden} msg] $msg \
- [file delete -force foo.dir]
-} {0 0 {}}
-
-test macFCmd-2.1 {GetFileReadOnly - bad file} {macOnly} {
- catch {file delete -force foo.file}
- list [catch {file attributes foo.file -readonly} msg] $msg
-} {1 {could not read ":foo.file": no such file or directory}}
-test macFCmd-2.2 {GetFileReadOnly - file not read only} {macOnly} {
- catch {file delete -force foo.file}
- close [open foo.file w]
- list [catch {file attributes foo.file -readonly} msg] $msg \
- [file delete -force foo.file]
-} {0 0 {}}
-test macFCmd-2.3 {GetFileReadOnly - file read only} {macOnly} {
- catch {file delete -force foo.file}
- close [open foo.file w]
- file attributes foo.file -readonly 1
- list [catch {file attributes foo.file -readonly} msg] $msg \
- [file delete -force foo.file]
-} {0 1 {}}
-test macFCmd-2.4 {GetFileReadOnly - directory not read only} {macOnly} {
- catch {file delete -force foo.dir}
- file mkdir foo.dir
- list [catch {file attributes foo.dir -readonly} msg] $msg \
- [file delete -force foo.dir]
-} {0 0 {}}
-test macFCmd-2.5 {GetFileReadOnly - directory read only} {macOnly fileSharing} {
- catch {file delete -force foo.dir}
- file mkdir foo.dir
- file attributes foo.dir -readonly 1
- list [catch {file attributes foo.dir -readonly} msg] $msg \
- [file delete -force foo.dir]
-} {0 1 {}}
-
-test macFCmd-3.1 {SetFileFinderAttributes - bad file} {macOnly} {
- catch {file delete -force foo.file}
- list [catch {file attributes foo.file -creator FOOO} msg] $msg
-} {1 {could not read ":foo.file": no such file or directory}}
-test macFCmd-3.2 {SetFileFinderAttributes - creator} {macOnly} {
- catch {file delete -force foo.file}
- close [open foo.file w]
- list [catch {file attributes foo.file -creator FOOO} msg] $msg \
- [file attributes foo.file -creator] [file delete -force foo.file]
-} {0 {} FOOO {}}
-test macFCmd-3.3 {SetFileFinderAttributes - bad creator} {macOnly} {
- catch {file delete -force foo.file}
- close [open foo.file w]
- list [catch {file attributes foo.file -creator 0} msg] $msg \
- [file delete -force foo.file]
-} {1 {expected Macintosh OS type but got "0"} {}}
-test macFCmd-3.4 {SetFileFinderAttributes - hidden} {macOnly} {
- catch {file delete -force foo.file}
- close [open foo.file w]
- list [catch {file attributes foo.file -hidden 1} msg] $msg \
- [file attributes foo.file -hidden] [file delete -force foo.file]
-} {0 {} 1 {}}
-test macFCmd-3.5 {SetFileFinderAttributes - type} {macOnly} {
- catch {file delete -force foo.file}
- close [open foo.file w]
- list [catch {file attributes foo.file -type FOOO} msg] $msg \
- [file attributes foo.file -type] [file delete -force foo.file]
-} {0 {} FOOO {}}
-test macFCmd-3.6 {SetFileFinderAttributes - bad type} {macOnly} {
- catch {file delete -force foo.file}
- close [open foo.file w]
- list [catch {file attributes foo.file -type 0} msg] $msg \
- [file delete -force foo.file]
-} {1 {expected Macintosh OS type but got "0"} {}}
-test macFCmd-3.7 {SetFileFinderAttributes - directory} {macOnly} {
- catch {file delete -force foo.dir}
- file mkdir foo.dir
- list [catch {file attributes foo.dir -creator FOOO} msg] \
- $msg [file delete -force foo.dir]
-} {1 {cannot set -creator: ":foo.dir" is a directory} {}}
-
-test macFCmd-4.1 {SetFileReadOnly - bad file} {macOnly} {
- catch {file delete -force foo.file}
- list [catch {file attributes foo.file -readonly 1} msg] $msg
-} {1 {could not read ":foo.file": no such file or directory}}
-test macFCmd-4.2 {SetFileReadOnly - file not readonly} {macOnly} {
- catch {file delete -force foo.file}
- close [open foo.file w]
- list [catch {file attributes foo.file -readonly 0} msg] \
- $msg [file attributes foo.file -readonly] [file delete -force foo.file]
-} {0 {} 0 {}}
-test macFCmd-4.3 {SetFileReadOnly - file readonly} {macOnly} {
- catch {file delete -force foo.file}
- close [open foo.file w]
- list [catch {file attributes foo.file -readonly 1} msg] \
- $msg [file attributes foo.file -readonly] [file delete -force foo.file]
-} {0 {} 1 {}}
-test macFCmd-4.4 {SetFileReadOnly - directory not readonly} \
- {macOnly fileSharing} {
- catch {file delete -force foo.dir}
- file mkdir foo.dir
- list [catch {file attributes foo.dir -readonly 0} msg] \
- $msg [file attributes foo.dir -readonly] [file delete -force foo.dir]
-} {0 {} 0 {}}
-test macFCmd-4.5 {SetFileReadOnly - directory not readonly} \
- {macOnly notFileSharing} {
- catch {file delete -force foo.dir}
- file mkdir foo.dir
- list [catch {file attributes foo.dir -readonly 0} msg] $msg \
- [file delete -force foo.dir]
-} {1 {cannot set a directory to read-only when File Sharing is turned off} {}}
-test macFCmd-4.6 {SetFileReadOnly - directory readonly} {macOnly fileSharing} {
- catch {file delete -force foo.dir}
- file mkdir foo.dir
- list [catch {file attributes foo.dir -readonly 1} msg] $msg \
- [file attributes foo.dir -readonly] [file delete -force foo.dir]
-} {0 {} 1 {}}
-test macFCmd-4.7 {SetFileReadOnly - directory readonly} {macOnly notFileSharing} {
- catch {file delete -force foo.dir}
- file mkdir foo.dir
- list [catch {file attributes foo.dir -readonly 1} msg] $msg \
- [file delete -force foo.dir]
-} {1 {cannot set a directory to read-only when File Sharing is turned off} {}}
-
-# cleanup
-::tcltest::cleanupTests
-return
-
-
-
-
-
-
-
-
-
-
-
-
+++ /dev/null
-# This file tests the tclUnixFCmd.c file.
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
-#
-# Copyright (c) 1996 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id$
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-# Several tests require need to match results against the unix username
-set user {}
-if {$tcl_platform(platform) == "unix"} {
- catch {set user [exec whoami]}
- if {$user == ""} {
- catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
- }
- if {$user == ""} {
- set user "root"
- }
-}
-
-proc openup {path} {
- testchmod 777 $path
- if {[file isdirectory $path]} {
- catch {
- foreach p [glob -directory $path *] {
- openup $p
- }
- }
- }
-}
-
-proc cleanup {args} {
- foreach p ". $args" {
- set x ""
- catch {
- set x [glob -directory $p tf* td*]
- }
- foreach file $x {
- if {[catch {file delete -force -- $file}]} {
- openup $file
- file delete -force -- $file
- }
- }
- }
-}
-
-test unixFCmd-1.1 {TclpRenameFile: EACCES} {unixOnly notRoot} {
- cleanup
- file mkdir td1/td2/td3
- exec chmod 000 td1/td2
- set msg [list [catch {file rename td1/td2/td3 td2} msg] $msg]
- exec chmod 755 td1/td2
- set msg
-} {1 {error renaming "td1/td2/td3": permission denied}}
-test unixFCmd-1.2 {TclpRenameFile: EEXIST} {unixOnly notRoot} {
- cleanup
- file mkdir td1/td2
- file mkdir td2
- list [catch {file rename td2 td1} msg] $msg
-} {1 {error renaming "td2" to "td1/td2": file already exists}}
-test unixFCmd-1.3 {TclpRenameFile: EINVAL} {unixOnly notRoot} {
- cleanup
- file mkdir td1
- list [catch {file rename td1 td1} msg] $msg
-} {1 {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself}}
-test unixFCmd-1.4 {TclpRenameFile: EISDIR} {emptyTest unixOnly notRoot} {
- # can't make it happen
-} {}
-test unixFCmd-1.5 {TclpRenameFile: ENOENT} {unixOnly notRoot} {
- cleanup
- file mkdir td1
- list [catch {file rename td2 td1} msg] $msg
-} {1 {error renaming "td2": no such file or directory}}
-test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unixOnly notRoot} {
- # can't make it happen
-} {}
-test unixFCmd-1.7 {TclpRenameFile: EXDEV} {unixOnly notRoot} {
- cleanup
- file mkdir foo/bar
- file attr foo -perm 040555
- set catchResult [catch {file rename foo/bar /tmp} msg]
- set msg [lindex [split $msg :] end]
- catch {file delete /tmp/bar}
- catch {file attr foo -perm 040777}
- catch {file delete -force foo}
- list $catchResult $msg
-} {1 { permission denied}}
-test unixFCmd-1.8 {Checking EINTR Bug} {unixOnly notRoot nonPortable} {
- testalarm
- after 2000
- list [testgotsig] [testgotsig]
-} {1 0}
-test unixFCmd-1.9 {Checking EINTR Bug} {unixOnly notRoot nonPortable} {
- cleanup
- set f [open tfalarm w]
- puts $f {
- after 2000
- puts "hello world"
- exit 0
- }
- close $f
- testalarm
- set pipe [open "|[info nameofexecutable] tfalarm" r+]
- set line [read $pipe 1]
- catch {close $pipe}
- list $line [testgotsig]
-} {h 1}
-test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \
- {unixOnly notRoot} {
- cleanup
- exec touch tf1
- exec touch tf2
- file copy -force tf1 tf2
-} {}
-test unixFCmd-2.2 {TclpCopyFile: src is symlink} {unixOnly notRoot} {
- cleanup
- exec ln -s tf1 tf2
- file copy tf2 tf3
- file type tf3
-} {link}
-test unixFCmd-2.3 {TclpCopyFile: src is block} {unixOnly notRoot} {
- cleanup
- set null "/dev/null"
- while {[file type $null] != "characterSpecial"} {
- set null [file join [file dirname $null] [file readlink $null]]
- }
- # file copy $null tf1
-} {}
-test unixFCmd-2.4 {TclpCopyFile: src is fifo} {unixOnly notRoot} {
- cleanup
- if [catch {exec mknod tf1 p}] {
- list 1
- } else {
- file copy tf1 tf2
- expr {"[file type tf1]" == "[file type tf2]"}
- }
-} {1}
-test unixFCmd-2.5 {TclpCopyFile: copy attributes} {unixOnly notRoot} {
- cleanup
- exec touch tf1
- exec chmod 472 tf1
- file copy tf1 tf2
- string range [exec ls -l tf2] 0 9
-} {-r--rwx-w-}
-
-test unixFCmd-3.1 {CopyFile not done} {emptyTest unixOnly notRoot} {
-} {}
-
-test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unixOnly notRoot} {
-} {}
-
-test unixFCmd-5.1 {TclpCreateDirectory not done} {emptyTest unixOnly notRoot} {
-} {}
-
-test unixFCmd-6.1 {TclpCopyDirectory not done} {emptyTest unixOnly notRoot} {
-} {}
-
-test unixFCmd-7.1 {TclpRemoveDirectory not done} {emptyTest unixOnly notRoot} {
-} {}
-
-test unixFCmd-8.1 {TraverseUnixTree not done} {emptyTest unixOnly notRoot} {
-} {}
-
-test unixFCmd-9.1 {TraversalCopy not done} {emptyTest unixOnly notRoot} {
-} {}
-
-test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unixOnly notRoot} {
-} {}
-
-test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unixOnly notRoot} {
-} {}
-
-test unixFCmd-12.1 {GetGroupAttribute - file not found} {unixOnly notRoot} {
- catch {file delete -force -- foo.test}
- list [catch {file attributes foo.test -group} msg] $msg
-} {1 {could not read "foo.test": no such file or directory}}
-test unixFCmd-12.2 {GetGroupAttribute - file found} {unixOnly notRoot} {
- catch {file delete -force -- foo.test}
- close [open foo.test w]
- list [catch {file attributes foo.test -group}] [file delete -force -- foo.test]
-} {0 {}}
-
-test unixFCmd-13.1 {GetOwnerAttribute - file not found} {unixOnly notRoot} {
- catch {file delete -force -- foo.test}
- list [catch {file attributes foo.test -group} msg] $msg
-} {1 {could not read "foo.test": no such file or directory}}
-test unixFCmd-13.2 {GetOwnerAttribute} {unixOnly notRoot} {
- catch {file delete -force -- foo.test}
- close [open foo.test w]
- list [catch {file attributes foo.test -owner} msg] \
- [string compare $msg $user] [file delete -force -- foo.test]
-} {0 0 {}}
-
-test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {unixOnly notRoot} {
- catch {file delete -force -- foo.test}
- list [catch {file attributes foo.test -permissions} msg] $msg
-} {1 {could not read "foo.test": no such file or directory}}
-test unixFCmd-14.2 {GetPermissionsAttribute} {unixOnly notRoot} {
- catch {file delete -force -- foo.test}
- close [open foo.test w]
- list [catch {file attribute foo.test -permissions}] \
- [file delete -force -- foo.test]
-} {0 {}}
-
-# Find a group that exists on this system, or else skip tests that require
-# groups
-set ::tcltest::testConstraints(foundGroup) 0
-catch {
- set groupList [exec groups]
- set group [lindex $groupList 0]
- set ::tcltest::testConstraints(foundGroup) 1
-}
-
-#groups hard to test
-test unixFCmd-15.1 {SetGroupAttribute - invalid group} {unixOnly notRoot} {
- catch {file delete -force -- foo.test}
- list [catch {file attributes foo.test -group foozzz} msg] \
- $msg [file delete -force -- foo.test]
-} {1 {could not set group for file "foo.test": group "foozzz" does not exist} {}}
-test unixFCmd-15.2 {SetGroupAttribute - invalid file} \
- {unixOnly notRoot foundGroup} {
- catch {file delete -force -- foo.test}
- list [catch {file attributes foo.test -group $group} msg] $msg
-} {1 {could not set group for file "foo.test": no such file or directory}}
-
-#changing owners hard to do
-test unixFCmd-16.1 {SetOwnerAttribute - current owner} {unixOnly notRoot} {
- catch {file delete -force -- foo.test}
- close [open foo.test w]
- list [catch {file attributes foo.test -owner $user} msg] \
- $msg [string compare [file attributes foo.test -owner] $user] \
- [file delete -force -- foo.test]
-} {0 {} 0 {}}
-test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {unixOnly notRoot} {
- catch {file delete -force -- foo.test}
- list [catch {file attributes foo.test -owner $user} msg] $msg
-} {1 {could not set owner for file "foo.test": no such file or directory}}
-test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {unixOnly notRoot} {
- catch {file delete -force -- foo.test}
- list [catch {file attributes foo.test -owner foozzz} msg] $msg
-} {1 {could not set owner for file "foo.test": user "foozzz" does not exist}}
-
-
-test unixFCmd-17.1 {SetPermissionsAttribute} {unixOnly notRoot} {
- catch {file delete -force -- foo.test}
- close [open foo.test w]
- list [catch {file attributes foo.test -permissions 0000} msg] \
- $msg [file attributes foo.test -permissions] \
- [file delete -force -- foo.test]
-} {0 {} 00000 {}}
-test unixFCmd-17.2 {SetPermissionsAttribute} {unixOnly notRoot} {
- catch {file delete -force -- foo.test}
- list [catch {file attributes foo.test -permissions 0000} msg] $msg
-} {1 {could not set permissions for file "foo.test": no such file or directory}}
-test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} {
- catch {file delete -force -- foo.test}
- close [open foo.test w]
- list [catch {file attributes foo.test -permissions foo} msg] $msg \
- [file delete -force -- foo.test]
-} {1 {unknown permission string format "foo"} {}}
-test unixFCmd-17.3 {SetPermissionsAttribute} {unixOnly notRoot} {
- catch {file delete -force -- foo.test}
- close [open foo.test w]
- list [catch {file attributes foo.test -permissions ---rwx} msg] $msg \
- [file delete -force -- foo.test]
-} {1 {unknown permission string format "---rwx"} {}}
-
-close [open foo.test w]
-set ::i 4
-proc permcheck {permstr expected} {
- test unixFCmd-17.[incr ::i] {SetPermissionsAttribute} {unixOnly notRoot} \
- [subst {
- file attributes foo.test -permissions $permstr
- file attributes foo.test -permissions
- }
- ] $expected
-}
-permcheck rwxrwxrwx 00777
-permcheck r--r---w- 00442
-permcheck 0 00000
-permcheck u+rwx,g+r 00740
-permcheck u-w 00540
-permcheck o+rwx 00547
-permcheck --x--x--x 00111
-permcheck a+rwx 00777
-file delete -force -- foo.test
-
-test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} {
- # This test is nonportable because SunOS generates a weird error
- # message when the current directory isn't readable.
- set cd [pwd]
- set nd $cd/tstdir
- file mkdir $nd
- cd $nd
- exec chmod 000 $nd
- set r [list [catch {pwd} res] [string range $res 0 36]];
- cd $cd;
- exec chmod 755 $nd
- file delete $nd
- set r
-} {1 {error getting working directory name:}}
-
-# cleanup
-cleanup
-::tcltest::cleanupTests
-return
-
-
-
-
-
-
-
-
-
-
-
-
+++ /dev/null
-# This file contains tests for the routines in the file tclUnixFile.c
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
-#
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id$
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-if {[info commands testobj] == {}} {
- puts "This application hasn't been compiled with the \"testfindexecutable\""
- puts "command, so I can't test the Tcl_FindExecutable function"
- ::tcltest::cleanupTests
- return
-}
-
-catch {
- set oldPath $env(PATH)
- close [open junk w]
- file attributes junk -perm 0777
-}
-set absPath [file join [pwd] junk]
-
-test unixFile-1.1 {Tcl_FindExecutable} {unixOnly} {
- set env(PATH) ""
- testfindexecutable junk
-} $absPath
-test unixFile-1.2 {Tcl_FindExecutable} {unixOnly} {
- set env(PATH) "/dummy"
- testfindexecutable junk
-} {}
-test unixFile-1.3 {Tcl_FindExecutable} {unixOnly} {
- set env(PATH) "/dummy:[pwd]"
- testfindexecutable junk
-} $absPath
-test unixFile-1.4 {Tcl_FindExecutable} {unixOnly} {
- set env(PATH) "/dummy:"
- testfindexecutable junk
-} $absPath
-test unixFile-1.5 {Tcl_FindExecutable} {unixOnly} {
- set env(PATH) "/dummy:/dummy"
- testfindexecutable junk
-} {}
-test unixFile-1.6 {Tcl_FindExecutable} {unixOnly} {
- set env(PATH) "/dummy::/dummy"
- testfindexecutable junk
-} $absPath
-test unixFile-1.7 {Tcl_FindExecutable} {unixOnly} {
- set env(PATH) ":/dummy"
- testfindexecutable junk
-} $absPath
-
-# cleanup
-catch {set env(PATH) $oldPath}
-file delete junk
-::tcltest::cleanupTests
-return
-
-
-
-
-
-
-
-
-
-
-
-
+++ /dev/null
-# This file tests the tclWinFCmd.c file.
-#
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
-#
-# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id$
-#
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-proc createfile {file {string a}} {
- set f [open $file w]
- puts -nonewline $f $string
- close $f
- return $string
-}
-
-proc contents {file} {
- set f [open $file r]
- set r [read $f]
- close $f
- set r
-}
-
-proc cleanup {args} {
- foreach p ". $args" {
- set x ""
- catch {
- set x [glob -directory $p tf* td*]
- }
- if {$x != ""} {
- catch {eval file delete -force -- $x}
- }
- }
-}
-
-set ::tcltest::testConstraints(cdrom) 0
-set ::tcltest::testConstraints(exdev) 0
-
-# find a CD-ROM so we can test read-only filesystems.
-
-set cdrom {}
-set nodrive x:
-foreach p {d e f g h i j k l m n o p q r s t u v w x y z} {
- set name ${p}:/dummy~~.fil
- if [catch {set fd [open $name w]}] {
- set err [lindex $errorCode 1]
- if {$cdrom == "" && $err == "EACCES"} {
- set cdrom ${p}:
- }
- if {$err == "ENOENT"} {
- set nodrive ${p}:
- }
- } else {
- close $fd
- file delete $name
- }
-}
-
-proc findfile {dir} {
- foreach p [glob $dir/*] {
- if {[file type $p] == "file"} {
- return $p
- }
- }
- foreach p [glob $dir/*] {
- if {[file type $p] == "directory"} {
- set f [findfile $p]
- if {$f != ""} {
- return $f
- }
- }
- }
- return ""
-}
-
-if {$cdrom != ""} {
- set ::tcltest::testConstraints(cdrom) 1
- set cdfile [findfile $cdrom]
-}
-
-if {[file exists c:/] && [file exists d:/]} {
- catch {file delete d:/tf1}
- if {[catch {close [open d:/tf1 w]}] == 0} {
- file delete d:/tf1
- set ::tcltest::testConstraints(exdev) 1
- }
-}
-
-file delete -force -- td1
-set foo [catch {open td1 w} testfile]
-if {$foo} {
- set ::tcltest::testConstraints(longFileNames) 0
-} else {
- close $testfile
- set ::tcltest::testConstraints(longFileNames) 1
- file delete -force -- td1
-}
-
-# A really long file name
-# length of longname is 1216 chars, which should be greater than any static
-# buffer or allowable filename.
-
-set longname "abcdefghihjllmnopqrstuvwxyz01234567890"
-append longname $longname
-append longname $longname
-append longname $longname
-append longname $longname
-append longname $longname
-
-# Uses the "testfile" command instead of the "file" command. The "file"
-# command provides several layers of sanity checks on the arguments and
-# it can be difficult to actually forward "insane" arguments to the
-# low-level posix emulation layer.
-
-test winFCmd-1.1 {TclpRenameFile: errno: EACCES} {pcOnly cdrom} {
- list [catch {testfile mv $cdfile $cdrom/dummy~~.fil} msg] $msg
-} {1 EACCES}
-test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} {pcOnly} {
- cleanup
- file mkdir td1/td2/td3
- file mkdir td2
- list [catch {testfile mv td2 td1/td2} msg] $msg
-} {1 EEXIST}
-test winFCmd-1.3 {TclpRenameFile: errno: EINVAL} {pcOnly} {
- cleanup
- list [catch {testfile mv / td1} msg] $msg
-} {1 EINVAL}
-test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} {pcOnly} {
- cleanup
- file mkdir td1
- list [catch {testfile mv td1 td1/td2} msg] $msg
-} {1 EINVAL}
-test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} {pcOnly} {
- cleanup
- file mkdir td1
- createfile tf1
- list [catch {testfile mv tf1 td1} msg] $msg
-} {1 EISDIR}
-test winFCmd-1.6 {TclpRenameFile: errno: ENOENT} {pcOnly} {
- cleanup
- list [catch {testfile mv tf1 tf2} msg] $msg
-} {1 ENOENT}
-test winFCmd-1.7 {TclpRenameFile: errno: ENOENT} {pcOnly} {
- cleanup
- list [catch {testfile mv "" tf2} msg] $msg
-} {1 ENOENT}
-test winFCmd-1.8 {TclpRenameFile: errno: ENOENT} {pcOnly} {
- cleanup
- createfile tf1
- list [catch {testfile mv tf1 ""} msg] $msg
-} {1 ENOENT}
-test winFCmd-1.9 {TclpRenameFile: errno: ENOTDIR} {pcOnly} {
- cleanup
- file mkdir td1
- createfile tf1
- list [catch {testfile mv td1 tf1} msg] $msg
-} {1 ENOTDIR}
-test winFCmd-1.10 {TclpRenameFile: errno: EXDEV} {pcOnly exdev} {
- file delete -force d:/tf1
- file mkdir c:/tf1
- set msg [list [catch {testfile mv c:/tf1 d:/tf1} msg] $msg]
- file delete -force c:/tf1
- set msg
-} {1 EXDEV}
-test winFCmd-1.11 {TclpRenameFile: errno: EACCES} {pcOnly} {
- cleanup
- set fd [open tf1 w]
- set msg [list [catch {testfile mv tf1 tf2} msg] $msg]
- close $fd
- set msg
-} {1 EACCES}
-test winFCmd-1.12 {TclpRenameFile: errno: EACCES} {pcOnly} {
- cleanup
- createfile tf1
- set fd [open tf2 w]
- set msg [list [catch {testfile mv tf1 tf2} msg] $msg]
- close $fd
- set msg
-} {1 EACCES}
-test winFCmd-1.13 {TclpRenameFile: errno: EACCES} {pcOnly} {
- cleanup
- list [catch {testfile mv nul tf1} msg] $msg
-} {1 EACCES}
-test winFCmd-1.14 {TclpRenameFile: errno: EACCES} {95} {
- cleanup
- createfile tf1
- list [catch {testfile mv tf1 nul} msg] $msg
-} {1 EACCES}
-test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} {nt} {
- cleanup
- createfile tf1
- list [catch {testfile mv tf1 nul} msg] $msg
-} {1 EEXIST}
-test winFCmd-1.16 {TclpRenameFile: MoveFile() != FALSE} {pcOnly} {
- cleanup
- createfile tf1 tf1
- testfile mv tf1 tf2
- list [file exists tf1] [contents tf2]
-} {0 tf1}
-test winFCmd-1.17 {TclpRenameFile: MoveFile() == FALSE} {pcOnly} {
- cleanup
- list [catch {testfile mv tf1 tf2} msg] $msg
-} {1 ENOENT}
-test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} {pcOnly} {
- cleanup
- list [catch {testfile mv tf1 tf2} msg] $msg
-} {1 ENOENT}
-test winFCmd-1.19 {TclpRenameFile: errno == EACCES} {pcOnly} {
- cleanup
- list [catch {testfile mv nul tf1} msg] $msg
-} {1 EACCES}
-test winFCmd-1.20 {TclpRenameFile: src is dir} {nt} {
- # under 95, this would actually succeed and move the current dir out from
- # under the current process!
- cleanup
- file delete /tf1
- list [catch {testfile mv [pwd] /tf1} msg] $msg
-} {1 EACCES}
-test winFCmd-1.21 {TclpRenameFile: long src} {pcOnly} {
- cleanup
- list [catch {testfile mv $longname tf1} msg] $msg
-} {1 ENAMETOOLONG}
-test winFCmd-1.22 {TclpRenameFile: long dst} {pcOnly} {
- cleanup
- createfile tf1
- list [catch {testfile mv tf1 $longname} msg] $msg
-} {1 ENAMETOOLONG}
-test winFCmd-1.23 {TclpRenameFile: move dir into self} {pcOnly} {
- cleanup
- file mkdir td1
- list [catch {testfile mv [pwd]/td1 td1/td2} msg] $msg
-} {1 EINVAL}
-test winFCmd-1.24 {TclpRenameFile: move a root dir} {pcOnly} {
- cleanup
- list [catch {testfile mv / c:/} msg] $msg
-} {1 EINVAL}
-test winFCmd-1.25 {TclpRenameFile: cross file systems} {pcOnly cdrom} {
- cleanup
- file mkdir td1
- list [catch {testfile mv td1 $cdrom/td1} msg] $msg
-} {1 EXDEV}
-test winFCmd-1.26 {TclpRenameFile: readonly fs} {pcOnly cdrom} {
- cleanup
- list [catch {testfile mv $cdfile $cdrom/dummy~~.fil} msg] $msg
-} {1 EACCES}
-test winFCmd-1.27 {TclpRenameFile: open file} {pcOnly} {
- cleanup
- set fd [open tf1 w]
- set msg [list [catch {testfile mv tf1 tf2} msg] $msg]
- close $fd
- set msg
-} {1 EACCES}
-test winFCmd-1.28 {TclpRenameFile: errno == EEXIST} {pcOnly} {
- cleanup
- createfile tf1
- createfile tf2
- testfile mv tf1 tf2
- list [file exist tf1] [file exist tf2]
-} {0 1}
-test winFCmd-1.29 {TclpRenameFile: src is dir} {pcOnly} {
- cleanup
- file mkdir td1
- createfile tf1
- list [catch {testfile mv td1 tf1} msg] $msg
-} {1 ENOTDIR}
-test winFCmd-1.30 {TclpRenameFile: dst is dir} {pcOnly} {
- cleanup
- file mkdir td1
- file mkdir td2/td2
- list [catch {testfile mv td1 td2} msg] $msg
-} {1 EEXIST}
-test winFCmd-1.31 {TclpRenameFile: TclpRemoveDirectory fails} {pcOnly} {
- cleanup
- file mkdir td1
- file mkdir td2/td2
- list [catch {testfile mv td1 td2} msg] $msg
-} {1 EEXIST}
-test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory succeeds} {pcOnly} {
- cleanup
- file mkdir td1/td2
- file mkdir td2
- testfile mv td1 td2
- list [file exist td1] [file exist td2] [file exist td2/td2]
-} {0 1 1}
-test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \
- {pcOnly exdev} {
- file mkdir d:/td1
- testchmod 000 d:/td1
- file mkdir c:/tf1
- set msg [list [catch {testfile mv c:/tf1 d:/td1} msg] $msg]
- set msg "$msg [file writable d:/td1]"
- file delete d:/td1
- file delete -force c:/tf1
- set msg
-} {1 EXDEV 0}
-test winFCmd-1.34 {TclpRenameFile: src is dir, dst is not} {pcOnly} {
- file mkdir td1
- createfile tf1
- list [catch {testfile mv td1 tf1} msg] $msg
-} {1 ENOTDIR}
-test winFCmd-1.35 {TclpRenameFile: src is not dir, dst is} {pcOnly} {
- file mkdir td1
- createfile tf1
- list [catch {testfile mv tf1 td1} msg] $msg
-} {1 EISDIR}
-test winFCmd-1.36 {TclpRenameFile: src and dst not dir} {pcOnly} {
- createfile tf1 tf1
- createfile tf2 tf2
- testfile mv tf1 tf2
- contents tf2
-} {tf1}
-test winFCmd-1.37 {TclpRenameFile: need to restore temp file} {pcOnly} {
- # Can't figure out how to cause this.
- # Need a file that can't be copied.
-} {}
-
-test winFCmd-2.1 {TclpCopyFile: errno: EACCES} {pcOnly cdrom} {
- cleanup
- list [catch {testfile cp $cdfile $cdrom/dummy~~.fil} msg] $msg
-} {1 EACCES}
-test winFCmd-2.2 {TclpCopyFile: errno: EISDIR} {pcOnly} {
- cleanup
- file mkdir td1
- list [catch {testfile cp td1 tf1} msg] $msg
-} {1 EISDIR}
-test winFCmd-2.3 {TclpCopyFile: errno: EISDIR} {pcOnly} {
- cleanup
- createfile tf1
- file mkdir td1
- list [catch {testfile cp tf1 td1} msg] $msg
-} {1 EISDIR}
-test winFCmd-2.4 {TclpCopyFile: errno: ENOENT} {pcOnly} {
- cleanup
- list [catch {testfile cp tf1 tf2} msg] $msg
-} {1 ENOENT}
-test winFCmd-2.5 {TclpCopyFile: errno: ENOENT} {pcOnly} {
- cleanup
- list [catch {testfile cp "" tf2} msg] $msg
-} {1 ENOENT}
-test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} {pcOnly} {
- cleanup
- createfile tf1
- list [catch {testfile cp tf1 ""} msg] $msg
-} {1 ENOENT}
-test winFCmd-2.7 {TclpCopyFile: errno: EACCES} {95} {
- cleanup
- createfile tf1
- set fd [open tf2 w]
- set msg [list [catch {testfile cp tf1 tf2} msg] $msg]
- close $fd
- set msg
-} {1 EACCES}
-test winFCmd-2.8 {TclpCopyFile: errno: EACCES} {nt} {
- cleanup
- list [catch {testfile cp nul tf1} msg] $msg
-} {1 EACCES}
-test winFCmd-2.9 {TclpCopyFile: errno: ENOENT} {95} {
- cleanup
- list [catch {testfile cp nul tf1} msg] $msg
-} {1 ENOENT}
-test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} {pcOnly} {
- cleanup
- createfile tf1 tf1
- testfile cp tf1 tf2
- list [contents tf1] [contents tf2]
-} {tf1 tf1}
-test winFCmd-2.11 {TclpCopyFile: CopyFile succeeds} {pcOnly} {
- cleanup
- createfile tf1 tf1
- createfile tf2 tf2
- testfile cp tf1 tf2
- list [contents tf1] [contents tf2]
-} {tf1 tf1}
-test winFCmd-2.12 {TclpCopyFile: CopyFile succeeds} {pcOnly} {
- cleanup
- createfile tf1 tf1
- testchmod 000 tf1
- testfile cp tf1 tf2
- list [contents tf2] [file writable tf2]
-} {tf1 0}
-test winFCmd-2.13 {TclpCopyFile: CopyFile fails} {pcOnly} {
- cleanup
- createfile tf1
- file mkdir td1
- list [catch {testfile cp tf1 td1} msg] $msg
-} {1 EISDIR}
-test winFCmd-2.14 {TclpCopyFile: errno == EACCES} {pcOnly} {
- cleanup
- file mkdir td1
- list [catch {testfile cp td1 tf1} msg] $msg
-} {1 EISDIR}
-test winFCmd-2.15 {TclpCopyFile: src is directory} {pcOnly} {
- cleanup
- file mkdir td1
- list [catch {testfile cp td1 tf1} msg] $msg
-} {1 EISDIR}
-test winFCmd-2.16 {TclpCopyFile: dst is directory} {pcOnly} {
- cleanup
- createfile tf1
- file mkdir td1
- list [catch {testfile cp tf1 td1} msg] $msg
-} {1 EISDIR}
-test winFCmd-2.17 {TclpCopyFile: dst is readonly} {pcOnly} {
- cleanup
- createfile tf1 tf1
- createfile tf2 tf2
- testchmod 000 tf2
- testfile cp tf1 tf2
- list [file writable tf2] [contents tf2]
-} {1 tf1}
-test winFCmd-2.18 {TclpCopyFile: still can't copy onto dst} {95} {
- cleanup
- createfile tf1
- createfile tf2
- testchmod 000 tf2
- set fd [open tf2]
- set msg [list [catch {testfile cp tf1 tf2} msg] $msg]
- close $fd
- set msg "$msg [file writable tf2]"
-} {1 EACCES 0}
-
-test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} {pcOnly cdrom} {
- list [catch {testfile rm $cdfile $cdrom/dummy~~.fil} msg] $msg
-} {1 EACCES}
-test winFCmd-3.2 {TclpDeleteFile: errno: EISDIR} {pcOnly} {
- cleanup
- file mkdir td1
- list [catch {testfile rm td1} msg] $msg
-} {1 EISDIR}
-test winFCmd-3.3 {TclpDeleteFile: errno: ENOENT} {pcOnly} {
- cleanup
- list [catch {testfile rm tf1} msg] $msg
-} {1 ENOENT}
-test winFCmd-3.4 {TclpDeleteFile: errno: ENOENT} {pcOnly} {
- cleanup
- list [catch {testfile rm ""} msg] $msg
-} {1 ENOENT}
-test winFCmd-3.5 {TclpDeleteFile: errno: EACCES} {pcOnly} {
- cleanup
- set fd [open tf1 w]
- set msg [list [catch {testfile rm tf1} msg] $msg]
- close $fd
- set msg
-} {1 EACCES}
-test winFCmd-3.6 {TclpDeleteFile: errno: EACCES} {pcOnly} {
- cleanup
- list [catch {testfile rm nul} msg] $msg
-} {1 EACCES}
-test winFCmd-3.7 {TclpDeleteFile: DeleteFile succeeds} {pcOnly} {
- cleanup
- createfile tf1
- testfile rm tf1
- file exist tf1
-} {0}
-test winFCmd-3.8 {TclpDeleteFile: DeleteFile fails} {pcOnly} {
- cleanup
- file mkdir td1
- list [catch {testfile rm td1} msg] $msg
-} {1 EISDIR}
-test winFCmd-3.9 {TclpDeleteFile: errno == EACCES} {pcOnly} {
- cleanup
- set fd [open tf1 w]
- set msg [list [catch {testfile rm tf1} msg] $msg]
- close $fd
- set msg
-} {1 EACCES}
-test winFCmd-3.10 {TclpDeleteFile: path is readonly} {pcOnly} {
- cleanup
- createfile tf1
- testchmod 000 tf1
- testfile rm tf1
- file exists tf1
-} {0}
-test winFCmd-3.11 {TclpDeleteFile: still can't remove path} {pcOnly} {
- cleanup
- set fd [open tf1 w]
- testchmod 000 tf1
- set msg [list [catch {testfile rm tf1} msg] $msg]
- close $fd
- set msg
-} {1 EACCES}
-
-test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} {nt cdrom} {
- list [catch {testfile mkdir $cdrom/dummy~~.dir} msg] $msg
-} {1 EACCES}
-test winFCmd-4.2 {TclpCreateDirectory: errno: EACCES} {95 cdrom} {
- list [catch {testfile mkdir $cdrom/dummy~~.dir} msg] $msg
-} {1 ENOSPC}
-test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} {pcOnly} {
- cleanup
- file mkdir td1
- list [catch {testfile mkdir td1} msg] $msg
-} {1 EEXIST}
-test winFCmd-4.4 {TclpCreateDirectory: errno: ENOENT} {pcOnly} {
- cleanup
- list [catch {testfile mkdir td1/td2} msg] $msg
-} {1 ENOENT}
-test winFCmd-4.5 {TclpCreateDirectory: CreateDirectory succeeds} {pcOnly} {
- cleanup
- testfile mkdir td1
- file type td1
-} {directory}
-
-test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} {pcOnly} {
- cleanup
- file mkdir td1
- testfile cpdir td1 td2
- list [file type td1] [file type td2]
-} {directory directory}
-
-test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} {pcOnly} {
- cleanup
- file mkdir td1
- testchmod 000 td1
- testfile rmdir td1
- file exist td1
-} {0}
-test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1/td2
- list [catch {testfile rmdir td1} msg] $msg
-} {1 {td1 EEXIST}}
-test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {pcOnly} {
- # can't test this w/o removing everything on your hard disk first!
- # testfile rmdir /
-} {}
-test winFCmd-6.4 {TclpRemoveDirectory: errno: ENOENT} {pcOnly} {
- cleanup
- list [catch {testfile rmdir td1} msg] $msg
-} {1 {td1 ENOENT}}
-test winFCmd-6.5 {TclpRemoveDirectory: errno: ENOENT} {pcOnly} {
- cleanup
- list [catch {testfile rmdir ""} msg] $msg
-} {1 ENOENT}
-test winFCmd-6.6 {TclpRemoveDirectory: errno: ENOTDIR} {pcOnly fsIsWritable} {
- cleanup
- createfile tf1
- list [catch {testfile rmdir tf1} msg] $msg
-} {1 {tf1 ENOTDIR}}
-test winFCmd-6.7 {TclpRemoveDirectory: RemoveDirectory succeeds} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- testfile rmdir td1
- file exists td1
-} {0}
-test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} {pcOnly fsIsWritable} {
- cleanup
- createfile tf1
- list [catch {testfile rmdir tf1} msg] $msg
-} {1 {tf1 ENOTDIR}}
-test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- testchmod 000 td1
- testfile rmdir td1
- file exists td1
-} {0}
-test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} {95} {
- cleanup
- list [catch {testfile rmdir nul} msg] $msg
-} {1 {nul EACCES}}
-test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} {nt} {
- cleanup
- list [catch {testfile rmdir /} msg] $msg
-} {1 {\ EACCES}}
-test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {95 fsIsWritable} {
- cleanup
- createfile tf1
- list [catch {testfile rmdir tf1} msg] $msg
-} {1 {tf1 ENOTDIR}}
-test winFCmd-6.13 {TclpRemoveDirectory: write-protected} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- testchmod 000 td1
- testfile rmdir td1
- file exists td1
-} {0}
-test winFCmd-6.14 {TclpRemoveDirectory: check if empty dir} {95 fsIsWritable} {
- cleanup
- file mkdir td1/td2
- list [catch {testfile rmdir td1} msg] $msg
-} {1 {td1 EEXIST}}
-test winFCmd-6.15 {TclpRemoveDirectory: !recursive} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1/td2
- list [catch {testfile rmdir td1} msg] $msg
-} {1 {td1 EEXIST}}
-test winFCmd-6.16 {TclpRemoveDirectory: recursive, but errno != EEXIST} {pcOnly} {
- cleanup
- createfile tf1
- list [catch {testfile rmdir -force tf1} msg] $msg
-} {1 {tf1 ENOTDIR}}
-test winFCmd-6.17 {TclpRemoveDirectory: calls TraverseWinTree} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1/td2
- testfile rmdir -force td1
- file exists td1
-} {0}
-
-test winFCmd-7.1 {TraverseWinTree: targetPtr == NULL} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1/td2/td3
- testfile rmdir -force td1
- file exists td1
-} {0}
-test winFCmd-7.2 {TraverseWinTree: targetPtr != NULL} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1/td2/td3
- testfile cpdir td1 td2
- list [file exists td1] [file exists td2]
-} {1 1}
-test winFCmd-7.3 {TraverseWinTree: sourceAttr == -1} {pcOnly} {
- cleanup
- list [catch {testfile cpdir td1 td2} msg] $msg
-} {1 {td1 ENOENT}}
-test winFCmd-7.4 {TraverseWinTree: source isn't directory} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- createfile td1/tf1 tf1
- testfile cpdir td1 td2
- contents td2/tf1
-} {tf1}
-test winFCmd-7.5 {TraverseWinTree: call TraversalCopy: DOTREE_F} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- createfile td1/tf1 tf1
- testfile cpdir td1 td2
- contents td2/tf1
-} {tf1}
-test winFCmd-7.6 {TraverseWinTree: call TraversalDelete: DOTREE_F} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- createfile td1/tf1 tf1
- testfile rmdir -force td1
- file exists td1
-} {0}
-test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- createfile td1/tf1 tf1
- testfile cpdir td1 td2
- contents td2/tf1
-} {tf1}
-test winFCmd-7.8 {TraverseWinTree: append \ to source if necessary} {95 cdrom} {
- list [catch {testfile rmdir $cdrom/} msg] $msg
-} "1 {$cdrom\\ EEXIST}"
-test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} {nt cdrom} {
- list [catch {testfile rmdir $cdrom/} msg] $msg
-} "1 {$cdrom\\ EACCES}"
-test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \
- {pcOnly} {
- # can't make it happen
-} {}
-test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- testchmod 000 td1
- createfile td1/tf1 tf1
- testfile cpdir td1 td2
- list [file exists td2] [file writable td2]
-} {1 0}
-test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- createfile td1/tf1 tf1
- testfile rmdir -force td1
- file exists td1
-} {0}
-test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- createfile td1/tf1 tf1
- testfile cpdir td1 td2
- contents td2/tf1
-} {tf1}
-test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} {95 fsIsWritable} {
- cleanup
- file mkdir td1
- list [catch {testfile cpdir td1 /} msg] $msg
-} {1 {\ EEXIST}}
-test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} {nt fsIsWritable} {
- cleanup
- file mkdir td1
- list [catch {testfile cpdir td1 /} msg] $msg
-} {1 {\ EACCES}}
-test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- testfile cpdir td1 td2
-} {}
-test winFCmd-7.17 {TraverseWinTree: recurse on files: one file} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- createfile td1/td2
- testfile cpdir td1 td2
- glob td2/*
-} {td2/td2}
-test winFCmd-7.18 {TraverseWinTree: recurse on files: several files and dir} \
- {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- createfile td1/tf1
- createfile td1/tf2
- file mkdir td1/td2/td3
- createfile td1/tf3
- createfile td1/tf4
- testfile cpdir td1 td2
- lsort [glob td2/*]
-} {td2/td2 td2/tf1 td2/tf2 td2/tf3 td2/tf4}
-test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- testchmod 000 td1
- createfile td1/tf1 tf1
- testfile cpdir td1 td2
- list [file exists td2] [file writable td2]
-} {1 0}
-test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} \
- {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- createfile td1/tf1 tf1
- testfile rmdir -force td1
- file exists td1
-} {0}
-test winFCmd-7.21 {TraverseWinTree: fill errorPtr} {pcOnly} {
- cleanup
- list [catch {testfile cpdir td1 td2} msg] $msg
-} {1 {td1 ENOENT}}
-
-test winFCmd-8.1 {TraversalCopy: DOTREE_F} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- list [catch {testfile cpdir td1 td1} msg] $msg
-} {1 {td1 EEXIST}}
-test winFCmd-8.2 {TraversalCopy: DOTREE_PRED} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1/td2
- testchmod 000 td1
- testfile cpdir td1 td2
- list [file writable td1] [file writable td1/td2]
-} {0 1}
-test winFCmd-8.3 {TraversalCopy: DOTREE_POSTD} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- testfile cpdir td1 td2
-} {}
-
-test winFCmd-9.1 {TraversalDelete: DOTREE_F} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- createfile td1/tf1
- testfile rmdir -force td1
-} {}
-test winFCmd-9.2 {TraversalDelete: DOTREE_F} {95 fsIsWritable} {
- cleanup
- file mkdir td1
- set fd [open td1/tf1 w]
- set msg [list [catch {testfile rmdir -force td1} msg] $msg]
- close $fd
- set msg
-} {1 {td1\tf1 EACCES}}
-test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1/td2
- testchmod 000 td1
- testfile rmdir -force td1
- file exists td1
-} {0}
-test winFCmd-9.4 {TraversalDelete: DOTREE_POSTD} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1/td1/td3/td4/td5
- testfile rmdir -force td1
-} {}
-
-test winFCmd-10.1 {AttributesPosixError - get} {pcOnly} {
- cleanup
- list [catch {file attributes td1 -archive} msg] $msg
-} {1 {could not read "td1": no such file or directory}}
-test winFCmd-10.2 {AttributesPosixError - set} {pcOnly} {
- cleanup
- list [catch {file attributes td1 -archive 0} msg] $msg
-} {1 {could not read "td1": no such file or directory}}
-
-test winFCmd-11.1 {GetWinFileAttributes} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {file attributes td1 -archive} msg] $msg [cleanup]
-} {0 1 {}}
-test winFCmd-11.2 {GetWinFileAttributes} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {file attributes td1 -readonly} msg] $msg [cleanup]
-} {0 0 {}}
-test winFCmd-11.3 {GetWinFileAttributes} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {file attributes td1 -hidden} msg] $msg [cleanup]
-} {0 0 {}}
-test winFCmd-11.4 {GetWinFileAttributes} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {file attributes td1 -system} msg] $msg [cleanup]
-} {0 0 {}}
-test winfcmd-11.5 {GetWinFileAttributes} {pcOnly} {
- # attr of relative paths that resolve to root was failing
- # don't care about answer, just that test runs.
-
- set old [pwd]
- cd c:/
- file attr c:
- file attr c:.
- file attr .
- cd $old
-} {}
-
-test winFCmd-12.1 {ConvertFileNameFormat} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
-} {0 td1 {}}
-test winFCmd-12.2 {ConvertFileNameFormat} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- close [open td1/td1 w]
- list [catch {string tolower [file attributes td1/td1 -longname]} msg] $msg [cleanup]
-} {0 td1/td1 {}}
-test winFCmd-12.3 {ConvertFileNameFormat} {pcOnly fsIsWritable} {
- cleanup
- file mkdir td1
- file mkdir td1/td2
- close [open td1/td3 w]
- list [catch {string tolower [file attributes td1/td2/../td3 -longname]} msg] $msg [cleanup]
-} {0 td1/td2/../td3 {}}
-test winFCmd-12.4 {ConvertFileNameFormat} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {string tolower [file attributes ./td1 -longname]} msg] $msg [cleanup]
-} {0 ./td1 {}}
-test winFCmd-12.5 {ConvertFileNameFormat: absolute path} {pcOnly} {
- list [file attributes / -longname] [file attributes \\ -longname]
-} {/ /}
-test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} {pcOnly} {
- catch {file delete -force -- c:/td1}
- close [open c:/td1 w]
- list [catch {string tolower [file attributes c:/td1 -longname]} msg] $msg [file delete -force -- c:/td1]
-} {0 c:/td1 {}}
-test winFCmd-12.7 {ConvertFileNameFormat} {nonPortable pcOnly} {
- string tolower [file attributes //bisque/tcl/ws -longname]
-} {//bisque/tcl/ws}
-test winFCmd-12.8 {ConvertFileNameFormat} {pcOnly longFileNames fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
-} {0 td1 {}}
-test winFCmd-12.10 {ConvertFileNameFormat} {longFileNames pcOnly fsIsWritable} {
- cleanup
- close [open td1td1td1 w]
- list [catch {file attributes td1td1td1 -shortname}] [cleanup]
-} {0 {}}
-test winFCmd-12.11 {ConvertFileNameFormat} {longFileNames pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {string tolower [file attributes td1 -shortname]} msg] $msg [cleanup]
-} {0 td1 {}}
-
-test winFCmd-13.1 {GetWinFileLongName} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
-} {0 td1 {}}
-
-test winFCmd-14.1 {GetWinFileShortName} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {string tolower [file attributes td1 -shortname]} msg] $msg [cleanup]
-} {0 td1 {}}
-
-test winFCmd-15.1 {SetWinFileAttributes} {pcOnly} {
- cleanup
- list [catch {file attributes td1 -archive 0} msg] $msg
-} {1 {could not read "td1": no such file or directory}}
-test winFCmd-15.2 {SetWinFileAttributes - archive} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {file attributes td1 -archive 1} msg] $msg [file attributes td1 -archive] [cleanup]
-} {0 {} 1 {}}
-test winFCmd-15.3 {SetWinFileAttributes - archive} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {file attributes td1 -archive 0} msg] $msg [file attributes td1 -archive] [cleanup]
-} {0 {} 0 {}}
-test winFCmd-15.4 {SetWinFileAttributes - hidden} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {file attributes td1 -hidden 1} msg] $msg [file attributes td1 -hidden] [file attributes td1 -hidden 0] [cleanup]
-} {0 {} 1 {} {}}
-test winFCmd-15.5 {SetWinFileAttributes - hidden} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {file attributes td1 -hidden 0} msg] $msg [file attributes td1 -hidden] [cleanup]
-} {0 {} 0 {}}
-test winFCmd-15.6 {SetWinFileAttributes - readonly} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {file attributes td1 -readonly 1} msg] $msg [file attributes td1 -readonly] [cleanup]
-} {0 {} 1 {}}
-test winFCmd-15.7 {SetWinFileAttributes - readonly} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {file attributes td1 -readonly 0} msg] $msg [file attributes td1 -readonly] [cleanup]
-} {0 {} 0 {}}
-test winFCmd-15.8 {SetWinFileAttributes - system} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {file attributes td1 -system 1} msg] $msg [file attributes td1 -system] [cleanup]
-} {0 {} 1 {}}
-test winFCmd-15.9 {SetWinFileAttributes - system} {pcOnly fsIsWritable} {
- cleanup
- close [open td1 w]
- list [catch {file attributes td1 -system 0} msg] $msg [file attributes td1 -system] [cleanup]
-} {0 {} 0 {}}
-test winFCmd-15.10 {SetWinFileAttributes - failing} {pcOnly cdrom} {
- cleanup
- catch {file attributes $cdfile -archive 1}
-} {1}
-
-# This block of code used to occur after the "return" call, so I'm
-# commenting it out and assuming that this code is still under construction.
-#foreach source {tef ted tnf tnd "" nul com1} {
-# foreach chmodsrc {000 755} {
-# foreach dest "tfn tfe tdn tdempty tdfull td1/td2 $p $p/td1 {} nul" {
-# foreach chmoddst {000 755} {
-# puts hi
-# cleanup
-# file delete -force ted tef
-# file mkdir ted
-# createfile tef
-# createfile tfe
-# file mkdir tdempty
-# file mkdir tdfull/td1/td2
-#
-# catch {testchmod $chmodsrc $source}
-# catch {testchmod $chmoddst $dest}
-#
-# if [catch {file rename $source $dest} msg] {
-# puts "file rename $source ($chmodsrc) $dest ($chmoddst)"
-# puts $msg
-# }
-# }
-# }
-# }
-#}
-
-# cleanup
-cleanup
-::tcltest::cleanupTests
-return
-
-
-
-
-
-
-
-
-
-
-
-
+++ /dev/null
-# This file tests the tclWinFile.c file.\r#\r# This file contains a collection of tests for one or more of the Tcl\r# built-in commands. Sourcing this file into Tcl runs the tests and\r# generates output for errors. No output means no errors were found.\r#\r# Copyright (c) 1997 Sun Microsystems, Inc.\r# Copyright (c) 1998-1999 by Scriptics Corporation.\r#\r# See the file "license.terms" for information on usage and redistribution\r# of this file, and for a DISCLAIMER OF ALL WARRANTIES.\r#\r# RCS: @(#) $Id$\r\rif {[lsearch [namespace children] ::tcltest] == -1} {\r package require tcltest\r namespace import -force ::tcltest::*\r}\r\rtest winFile-1.1 {TclpGetUserHome} {pcOnly} {\r list [catch {glob ~nosuchuser} msg] $msg\r} {1 {user "nosuchuser" doesn't exist}}\rtest winFile-1.2 {TclpGetUserHome} {nt nonPortable} {\r # The administrator account should always exist.\r\r catch {glob ~administrator}\r} {0}\rtest winFile-1.2 {TclpGetUserHome} {95} {\r # Find some user in system.ini and then see if they have a home.\r\r set f [open $::env(windir)/system.ini]\r set x 0\r while {![eof $f]} {\r set line [gets $f]\r if {$line == "\[Password Lists]"} {\r gets $f\r set name [lindex [split [gets $f] =] 0]\r if {$name != ""} {\r set x [catch {glob ~$name}]\r break\r }\r }\r }\r close $f\r set x\r} {0}\rtest winFile-1.3 {TclpGetUserHome} {nt nonPortable} {\r catch {glob ~stanton@workgroup}\r} {0}\r\rtest winFile-2.1 {TclpMatchFiles: case sensitivity} {pcOnly fsIsWritable} {\r makeFile {} GlobCapS\r set result [list [glob -nocomplain GlobC*] [glob -nocomplain globc*]]\r removeFile GlobCapS\r set result\r} {GlobCapS GlobCapS}\r\rtest winFile-2.2 {TclpMatchFiles: case sensitivity} {pcOnly fsIsWritable} {\r makeFile {} globlower\r set result [list [glob -nocomplain globl*] [glob -nocomplain gLOBl*]]\r removeFile globlower\r set result\r} {globlower globlower}\r\r# cleanup\r::tcltest::cleanupTests\rreturn\r\r\r\r\r\r\r\r\r\r\r\r\r
\ No newline at end of file
projects / tclvfs / commitdiff