327 lines
12 KiB
Plaintext
327 lines
12 KiB
Plaintext
|
# Commands covered: 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) 1991-1993 The Regents of the University of California.
|
||
|
|
# All rights reserved.
|
||
|
|
#
|
||
|
|
# Permission is hereby granted, without written agreement and without
|
||
|
|
# license or royalty fees, to use, copy, modify, and distribute this
|
||
|
|
# software and its documentation for any purpose, provided that the
|
||
|
|
# above copyright notice and the following two paragraphs appear in
|
||
|
|
# all copies of this software.
|
||
|
|
#
|
||
|
|
# IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
|
||
|
|
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
|
||
|
|
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
|
||
|
|
# CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||
|
|
#
|
||
|
|
# THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
|
||
|
|
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
|
||
|
|
# AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
|
||
|
|
# ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
|
||
|
|
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
|
||
|
|
#
|
||
|
|
# $Header: /user6/ouster/tcl/tests/RCS/file.test,v 1.22 93/04/16 16:46:42 ouster Exp $ (Berkeley)
|
||
|
|
|
||
|
|
if {[string compare test [info procs test]] == 1} then {source defs}
|
||
|
|
|
||
|
|
# rootname and ext
|
||
|
|
|
||
|
|
test file-1.1 {rootname and extension options} {file ext abc.def} .def
|
||
|
|
test file-1.2 {rootname and extension options} {file ro abc.def} abc
|
||
|
|
test file-1.3 {rootname and extension options} {file extension a/b/c.d} .d
|
||
|
|
test file-1.4 {rootname and extension options} {file rootname a/b/c.d} a/b/c
|
||
|
|
test file-1.5 {rootname and extension options} {file extension a/b.c/d} {}
|
||
|
|
test file-1.6 {rootname and extension options} {file rootname a/b.c/d} a/b.c/d
|
||
|
|
set num 7
|
||
|
|
foreach outer { {} a .a a. a.a } {
|
||
|
|
foreach inner { {} a .a a. a.a } {
|
||
|
|
set thing [format %s/%s $outer $inner]
|
||
|
|
test file-1.$num {rootname and extension options} {
|
||
|
|
format %s%s [file rootname $thing] [file ext $thing]
|
||
|
|
} $thing
|
||
|
|
set num [expr $num+1]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# dirname and tail
|
||
|
|
|
||
|
|
test file-2.1 {dirname and tail options} {file dirname .def} .
|
||
|
|
test file-2.2 {dirname and tail options} {file tail abc.def} abc.def
|
||
|
|
test file-2.3 {dirname and tail options} {file d a/b/c.d} a/b
|
||
|
|
test file-2.4 {dirname and tail options} {file ta a/b/c.d} c.d
|
||
|
|
test file-2.5 {dirname and tail options} {file dirname a/b.c/d} a/b.c
|
||
|
|
test file-2.6 {dirname and tail options} {file tail a/b.c/d} d
|
||
|
|
set num 7
|
||
|
|
foreach outer { a .a a. a.a } {
|
||
|
|
foreach inner { {} a .a a. a.a } {
|
||
|
|
set thing [format %s/%s $outer $inner]
|
||
|
|
test file-2.$num {dirname and tail options} {
|
||
|
|
format %s/%s [file dirname $thing] [file tail $thing]
|
||
|
|
} $thing
|
||
|
|
set num [expr $num+1]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# exists
|
||
|
|
|
||
|
|
catch {exec chmod 777 dir.file}
|
||
|
|
catch {exec rm -f dir.file/gorp.file}
|
||
|
|
catch {exec rm -f gorp.file}
|
||
|
|
catch {exec rmdir dir.file}
|
||
|
|
catch {exec rm -f link.file}
|
||
|
|
test file-3.1 {exists option} {file exists gorp.file} 0
|
||
|
|
test file-3.2 {exists option} {file exists dir.file/gorp.file} 0
|
||
|
|
exec cat > gorp.file << abcde
|
||
|
|
exec mkdir dir.file
|
||
|
|
exec cat > dir.file/gorp.file << 12345
|
||
|
|
test file-3.3 {exists option} {file exists gorp.file} 1
|
||
|
|
test file-3.4 {exists option} {file exi dir.file/gorp.file} 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.
|
||
|
|
|
||
|
|
catch {exec rm /tmp/tcl.foo.dir/file}
|
||
|
|
catch {exec rmdir /tmp/tcl.foo.dir}
|
||
|
|
exec mkdir /tmp/tcl.foo.dir
|
||
|
|
exec cat > /tmp/tcl.foo.dir/file << 12345
|
||
|
|
exec chmod 000 /tmp/tcl.foo.dir
|
||
|
|
if {$user != "root"} {
|
||
|
|
test file-3.5 {exists option} {file exists /tmp/tcl.foo.dir/file} 0
|
||
|
|
}
|
||
|
|
exec chmod 775 /tmp/tcl.foo.dir
|
||
|
|
exec rm /tmp/tcl.foo.dir/file
|
||
|
|
exec rmdir /tmp/tcl.foo.dir
|
||
|
|
|
||
|
|
# executable
|
||
|
|
|
||
|
|
exec chmod 000 dir.file
|
||
|
|
if {$user != "root"} {
|
||
|
|
test file-4.1 {executable option} {file executable gorp.file} 0
|
||
|
|
}
|
||
|
|
exec chmod 775 gorp.file
|
||
|
|
test file-4.2 {executable option} {file exe gorp.file} 1
|
||
|
|
|
||
|
|
# isdirectory
|
||
|
|
|
||
|
|
test file-5.1 {isdirectory option} {file isdirectory gorp.file} 0
|
||
|
|
test file-5.2 {isdirectory option} {file isd dir.file} 1
|
||
|
|
|
||
|
|
# isfile
|
||
|
|
|
||
|
|
test file-6.1 {isfile option} {file isfile gorp.file} 1
|
||
|
|
test file-6.2 {isfile option} {file isfile dir.file} 0
|
||
|
|
|
||
|
|
# isowned
|
||
|
|
|
||
|
|
test file-7.1 {owned option} {file owned gorp.file} 1
|
||
|
|
if {$user != "root"} {
|
||
|
|
test file-7.2 {owned option} {file owned /} 0
|
||
|
|
}
|
||
|
|
|
||
|
|
# readable
|
||
|
|
|
||
|
|
exec chmod 444 gorp.file
|
||
|
|
test file-8.1 {readable option} {file readable gorp.file} 1
|
||
|
|
exec chmod 333 gorp.file
|
||
|
|
if {$user != "root"} {
|
||
|
|
test file-8.2 {readable option} {file reada gorp.file} 0
|
||
|
|
}
|
||
|
|
|
||
|
|
# writable
|
||
|
|
|
||
|
|
exec chmod 555 gorp.file
|
||
|
|
if {$user != "root"} {
|
||
|
|
test file-9.1 {writable option} {file writable gorp.file} 0
|
||
|
|
}
|
||
|
|
exec chmod 222 gorp.file
|
||
|
|
test file-9.2 {writable option} {file w gorp.file} 1
|
||
|
|
|
||
|
|
# stat
|
||
|
|
|
||
|
|
exec cat > gorp.file << "Test string"
|
||
|
|
exec chmod 765 gorp.file
|
||
|
|
test file-10.1 {stat option} {
|
||
|
|
catch {unset stat}
|
||
|
|
file stat gorp.file stat
|
||
|
|
lsort [array names stat]
|
||
|
|
} {atime ctime dev gid ino mode mtime nlink size type uid}
|
||
|
|
test file-10.2 {stat option} {
|
||
|
|
catch {unset stat}
|
||
|
|
file stat gorp.file stat
|
||
|
|
list $stat(nlink) $stat(size) [expr $stat(mode)&0777] $stat(type)
|
||
|
|
} {1 11 501 file}
|
||
|
|
test file-10.3 {stat option} {
|
||
|
|
string tolower [list [catch {file stat _bogus_ stat} msg] \
|
||
|
|
$msg $errorCode]
|
||
|
|
} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
|
||
|
|
test file-10.4 {stat option} {
|
||
|
|
list [catch {file stat _bogus_} msg] $msg $errorCode
|
||
|
|
} {1 {wrong # args: should be "file stat name varName"} NONE}
|
||
|
|
test file-10.5 {stat option} {
|
||
|
|
list [catch {file stat _bogus_ a b} msg] $msg $errorCode
|
||
|
|
} {1 {wrong # args: should be "file stat name varName"} NONE}
|
||
|
|
test file-10.6 {stat option} {
|
||
|
|
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}
|
||
|
|
catch {unset stat}
|
||
|
|
|
||
|
|
# mtime, and size (I've given up trying to find a test for "atime": there
|
||
|
|
# seem to be too many quirks in the way file systems handle this to come
|
||
|
|
# up with a reproducible test).
|
||
|
|
|
||
|
|
test file-11.1 {mtime and atime and size options} {
|
||
|
|
catch {unset stat}
|
||
|
|
file stat gorp.file stat
|
||
|
|
list [expr {[file mtime gorp.file] == $stat(mtime)}] \
|
||
|
|
[expr {[file atime gorp.file] == $stat(atime)}] \
|
||
|
|
[file size gorp.file]
|
||
|
|
} {1 1 11}
|
||
|
|
test file-11.2 {mtime option} {
|
||
|
|
set old [file mtime gorp.file]
|
||
|
|
exec sleep 2
|
||
|
|
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 file-11.3 {size option} {
|
||
|
|
set oldsize [file size gorp.file]
|
||
|
|
set f [open gorp.file a]
|
||
|
|
puts $f "More text"
|
||
|
|
close $f
|
||
|
|
expr {[file size gorp.file] - $oldsize}
|
||
|
|
} {10}
|
||
|
|
test file-11.4 {errors in atime option} {
|
||
|
|
list [catch {file atime _bogus_ x} msg] $msg $errorCode
|
||
|
|
} {1 {wrong # args: should be "file atime name"} NONE}
|
||
|
|
test file-11.5 {errors in atime option} {
|
||
|
|
string tolower [list [catch {file atime _bogus_} msg] \
|
||
|
|
$msg $errorCode]
|
||
|
|
} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
|
||
|
|
test file-11.6 {errors in mtime option} {
|
||
|
|
list [catch {file mtime _bogus_ x} msg] $msg $errorCode
|
||
|
|
} {1 {wrong # args: should be "file mtime name"} NONE}
|
||
|
|
test file-11.7 {errors in mtime option} {
|
||
|
|
string tolower [list [catch {file mtime _bogus_} msg] $msg \
|
||
|
|
$errorCode]
|
||
|
|
} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
|
||
|
|
test file-11.8 {errors in size option} {
|
||
|
|
list [catch {file size _bogus_ x} msg] $msg $errorCode
|
||
|
|
} {1 {wrong # args: should be "file size name"} NONE}
|
||
|
|
test file-11.9 {errors in size option} {
|
||
|
|
string tolower [list [catch {file size _bogus_} msg] $msg \
|
||
|
|
$errorCode]
|
||
|
|
} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
|
||
|
|
|
||
|
|
# type
|
||
|
|
|
||
|
|
test file-12.1 {type option} {
|
||
|
|
file type dir.file
|
||
|
|
} directory
|
||
|
|
test file-12.2 {type option} {
|
||
|
|
file type gorp.file
|
||
|
|
} file
|
||
|
|
if $atBerkeley {
|
||
|
|
exec ln -s a/b/c link.file
|
||
|
|
test file-12.3 {type option} {
|
||
|
|
file type link.file
|
||
|
|
} link
|
||
|
|
exec rm link.file
|
||
|
|
}
|
||
|
|
test file-12.4 {errors in type option} {
|
||
|
|
list [catch {file type a b} msg] $msg $errorCode
|
||
|
|
} {1 {wrong # args: should be "file type name"} NONE}
|
||
|
|
test file-12.5 {errors in type option} {
|
||
|
|
string tolower [list [catch {file type _bogus_} msg] $msg $errorCode]
|
||
|
|
} {1 {couldn't stat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
|
||
|
|
|
||
|
|
# lstat and readlink: run these tests only at Berkeley, since not all
|
||
|
|
# sites will have symbolic links
|
||
|
|
|
||
|
|
if $atBerkeley {
|
||
|
|
exec ln -s gorp.file link.file
|
||
|
|
test file-13.1 {lstat option} {
|
||
|
|
catch {unset stat}
|
||
|
|
file lstat link.file stat
|
||
|
|
lsort [array names stat]
|
||
|
|
} {atime ctime dev gid ino mode mtime nlink size type uid}
|
||
|
|
test file-13.1 {lstat option} {
|
||
|
|
catch {unset stat}
|
||
|
|
file lstat link.file stat
|
||
|
|
list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
|
||
|
|
} {1 511 link}
|
||
|
|
test file-13.3 {errors in lstat option} {
|
||
|
|
string tolower [list [catch {file lstat _bogus_ stat} msg] \
|
||
|
|
$msg $errorCode]
|
||
|
|
} {1 {couldn't lstat "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
|
||
|
|
test file-13.4 {errors in lstat option} {
|
||
|
|
list [catch {file lstat _bogus_} msg] $msg $errorCode
|
||
|
|
} {1 {wrong # args: should be "file lstat name varName"} NONE}
|
||
|
|
test file-13.5 {errors in lstat option} {
|
||
|
|
list [catch {file lstat _bogus_ a b} msg] $msg $errorCode
|
||
|
|
} {1 {wrong # args: should be "file lstat name varName"} NONE}
|
||
|
|
test file-13.6 {errors in lstat option} {
|
||
|
|
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}
|
||
|
|
|
||
|
|
test file-14.1 {readlink option} {
|
||
|
|
file readlink link.file
|
||
|
|
} gorp.file
|
||
|
|
test file-14.2 {errors in readlink option} {
|
||
|
|
list [catch {file readlink a b} msg] $msg $errorCode
|
||
|
|
} {1 {wrong # args: should be "file readlink name"} NONE}
|
||
|
|
test file-14.3 {errors in readlink option} {
|
||
|
|
list [catch {file readlink _bogus_} msg] $msg $errorCode
|
||
|
|
} {1 {couldn't readlink "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
|
||
|
|
|
||
|
|
exec rm link.file
|
||
|
|
}
|
||
|
|
|
||
|
|
# Error conditions
|
||
|
|
|
||
|
|
test file-15.1 {error conditions} {
|
||
|
|
list [catch file msg] $msg
|
||
|
|
} {1 {wrong # args: should be "file option name ?arg ...?"}}
|
||
|
|
test file-15.2 {error conditions} {
|
||
|
|
list [catch {file x} msg] $msg
|
||
|
|
} {1 {wrong # args: should be "file option name ?arg ...?"}}
|
||
|
|
test file-15.3 {error conditions} {
|
||
|
|
list [catch {file exists x too} msg] $msg
|
||
|
|
} {1 {wrong # args: should be "file exists name"}}
|
||
|
|
test file-15.4 {error conditions} {
|
||
|
|
list [catch {file gorp x} msg] $msg
|
||
|
|
} {1 {bad option "gorp": should be atime, dirname, executable, exists, extension, isdirectory, isfile, lstat, mtime, owned, readable, readlink, root, size, stat, tail, type, or writable}}
|
||
|
|
test file-15.5 {error conditions} {
|
||
|
|
list [catch {file ex x} msg] $msg
|
||
|
|
} {1 {bad option "ex": should be atime, dirname, executable, exists, extension, isdirectory, isfile, lstat, mtime, owned, readable, readlink, root, size, stat, tail, type, or writable}}
|
||
|
|
test file-15.6 {error conditions} {
|
||
|
|
list [catch {file is x} msg] $msg
|
||
|
|
} {1 {bad option "is": should be atime, dirname, executable, exists, extension, isdirectory, isfile, lstat, mtime, owned, readable, readlink, root, size, stat, tail, type, or writable}}
|
||
|
|
test file-15.7 {error conditions} {
|
||
|
|
list [catch {file read x} msg] $msg
|
||
|
|
} {1 {bad option "read": should be atime, dirname, executable, exists, extension, isdirectory, isfile, lstat, mtime, owned, readable, readlink, root, size, stat, tail, type, or writable}}
|
||
|
|
test file-15.8 {error conditions} {
|
||
|
|
list [catch {file s x} msg] $msg
|
||
|
|
} {1 {bad option "s": should be atime, dirname, executable, exists, extension, isdirectory, isfile, lstat, mtime, owned, readable, readlink, root, size, stat, tail, type, or writable}}
|
||
|
|
test file-15.9 {error conditions} {
|
||
|
|
list [catch {file t x} msg] $msg
|
||
|
|
} {1 {bad option "t": should be atime, dirname, executable, exists, extension, isdirectory, isfile, lstat, mtime, owned, readable, readlink, root, size, stat, tail, type, or writable}}
|
||
|
|
test file-15.10 {error conditions} {
|
||
|
|
list [catch {file rootname ~woohgy} msg] $msg
|
||
|
|
} {1 {user "woohgy" doesn't exist}}
|
||
|
|
|
||
|
|
exec chmod 777 dir.file
|
||
|
|
exec rm dir.file/gorp.file gorp.file
|
||
|
|
exec rmdir dir.file
|