stat.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!./perl
BEGIN {
chdir 't' if -d 't';
}
use Config;
my $tmpfile = 'Op_stat.tmp';
SKIP: {
}
SKIP: {
}
# Cygwin seems to have a 3 second granularity on its timestamps.
print FOO "Now is the time for all good men to come to.\n";
SKIP: {
my $lnk_result = eval { link $tmpfile, $tmpfile_link };
SKIP: {
}
SKIP: {
if $Is_Solaris and $cwd =~ m#^/tmp# and
if $cwd =~ m#$Config{'afsroot'}/#;
if $Is_Amiga;
# Win32 could pass $mtime test but as FAT and NTFS have
# no ctime concept $ctime is ALWAYS == $mtime
# expect netware to be the same ...
if $Is_MSWin32 ||
print STDERR <<DIAG;
# Check if you are on a tmpfs of some sort. Building in /tmp sometimes
# has this problem. Building on the ClearCase VOBS filesystem may also
# cause this failure.
#
# Darwin's UFS doesn't have a ctime concept, and thus is expected to fail
# this test.
DIAG
}
}
}
# truncate and touch $tmpfile.
close F;
print F "hi\n";
close F;
# Strip all access rights from the file.
SKIP: {
SKIP: {
# Going to try to switch away from root. Might not work.
my $olduid = $>;
eval { $> = 1; };
if $> == 0;
SKIP: {
}
# switch uid back (may not be implemented)
}
}
# in ms windows, $tmpfile inherits owner uid from directory
# not sure about os/2, but chown is harmless anyway
SKIP: {
if $Is_Dosish || $Is_MacOS;
}
# Is this portable?
SKIP: {
my $symlink_rslt = eval { symlink $tmpfile, $tmpfile_link };
}
SKIP: {
if $Is_MSWin32 || $Is_NetWare || $Is_Dos;
if $Is_MPRAS;
# or a symlink, or a socket, depending on which OS and how are
# you running the test, so let's censor that one away.
# Similar remarks hold for stderr.
# Srwx-----, not srwx------.
# If running as root, we will see .files in the ls result,
# and readdir() will see them always. Potential for conflict,
# so let's weed them out.
$DEV =~ s{^.+?\s\..+?$}{}m;
# Irix ls -l marks sockets with 'S' while 's' is a 'XENIX semaphore'.
}
my $try = sub {
};
SKIP: {
}
}
SKIP: {
# Find a set of directories that's very likely to have setuid files
# but not likely to be *all* setuid files.
$cnt++;
$uid++ if -u;
}
}
}
# may not be available (at, cron rsh etc), the PERL_SKIP_TTY_TEST env var
# can be set to skip the tests that need a tty.
SKIP: {
SKIP: {
}
{
}
}
SKIP: {
}
# These aren't strictly "stat" calls, but so what?
SKIP: {
}
SKIP: {
$_ = <FOO>;
$_ = <FOO>;
# It's documented this way in perlfunc *shrug*
}
SKIP: {
}
# and now, a few parsing tests:
$_ = $tmpfile;
# bug id 20011101.069
SKIP: {
stat $0;
eval { lstat _ };
eval { -l _ };
'-l _ croaks after stat' );
# bug id 20020124.004
# If we have d_lstat, we should have symlink()
-T _;
eval { lstat _ };
eval { -l _ };
'-l _ croaks after -T _' );
}
print "# Zzz...\n";
unlink $f;
my @a = stat $f;
print "# time=$^T, stat=(@a)\n";
my @b = (-M _, -A _, -C _);
print "# -MAC=(@b)\n";
END {
}