diag("\ncontinuing, assuming '.' for current directory. Some tests will be skipped.");
}
+if ($^O eq 'MSWin32') {
+ # under minitest, buildcustomize sets this to 1, which means
+ # nlinks isn't populated properly, allow nlinks tests to pass
+ ${^WIN32_SLOPPY_STAT} = 0;
+}
-plan tests => 113;
+plan tests => 115;
my $Perl = which_perl();
+$ENV{LC_ALL} = 'C'; # Forge English error messages.
+$ENV{LANGUAGE} = 'C'; # Ditto in GNU.
+
$Is_Amiga = $^O eq 'amigaos';
$Is_Cygwin = $^O eq 'cygwin';
$Is_Darwin = $^O eq 'darwin';
$Is_Dos = $^O eq 'dos';
-$Is_MPE = $^O eq 'mpeix';
$Is_MSWin32 = $^O eq 'MSWin32';
$Is_NetWare = $^O eq 'NetWare';
$Is_OS2 = $^O eq 'os2';
$Is_Solaris = $^O eq 'solaris';
$Is_VMS = $^O eq 'VMS';
-$Is_DGUX = $^O eq 'dgux';
$Is_MPRAS = $^O =~ /svr4/ && -f '/etc/.relid';
-$Is_Rhapsody= $^O eq 'rhapsody';
+$Is_Android = $^O =~ /android/;
$Is_Dosish = $Is_Dos || $Is_OS2 || $Is_MSWin32 || $Is_NetWare;
$Is_UFS = $Is_Darwin && (() = `df -t ufs . 2>/dev/null`) == 2;
-if ($Is_Cygwin) {
+if ($Is_Cygwin && !is_miniperl) {
require Win32;
Win32->import;
}
sleep 2;
+my $has_link = 1;
+my $inaccurate_atime = 0;
+if (defined &Win32::IsWinNT && Win32::IsWinNT()) {
+ if (Win32::FsType() ne 'NTFS') {
+ $has_link = 0;
+ $inaccurate_atime = 1;
+ }
+}
SKIP: {
+ skip "No link on this filesystem", 6 unless $has_link;
unlink $tmpfile_link;
my $lnk_result = eval { link $tmpfile, $tmpfile_link };
skip "link() unimplemented", 6 if $@ =~ /unimplemented/;
# Going to try to switch away from root. Might not work.
my $olduid = $>;
eval { $> = 1; };
+ skip "Can't test if an admin user in miniperl", 2,
+ if $Is_Cygwin && is_miniperl();
skip "Can't test -r or -w meaningfully if you're superuser", 2
if ($Is_Cygwin ? Win32::IsAdminUser : $> == 0);
skip "ls command not available to Perl in OpenVMS right now.", 6
if $Is_VMS;
- my $LS = $Config{d_readlink} ? "ls -lL" : "ls -l";
+ delete $ENV{CLICOLOR_FORCE};
+ my $LS = $Config{d_readlink} && !$Is_Android ? "ls -lL" : "ls -l";
my $CMD = "$LS /dev 2>/dev/null";
my $DEV = qx($CMD);
is($c1, $c2, "ls and $_[1] agreeing on /dev ($c1 $c2)");
};
-SKIP: {
- skip("DG/UX ls -L broken", 3) if $Is_DGUX;
-
+{
$try->('b', '-b');
$try->('c', '-c');
$try->('s', '-S');
-
}
ok(! -b $Curdir, '!-b cwd');
SKIP: {
skip "These tests require a TTY", 4 if $ENV{PERL_SKIP_TTY_TEST};
- my $TTY = $Is_Rhapsody ? "/dev/ttyp0" : "/dev/tty";
+ my $TTY = "/dev/tty";
SKIP: {
skip "Test uses unixisms", 2 if $Is_MSWin32 || $Is_NetWare;
my $statfile = './op/stat.t';
ok( -T $statfile, '-T');
ok(! -B $statfile, '!-B');
-
-SKIP: {
- skip("DG/UX", 1) if $Is_DGUX;
ok(-B $Perl, '-B');
-}
-
ok(! -T $Perl, '!-T');
open(FOO,$statfile);
'stat $ioref resets stat type';
{
- my @statbuf = stat STDOUT;
+ open(FOO, ">$tmpfile") || DIE("Can't open temp test file: $!");
+ my @statbuf = stat FOO;
stat "test.pl";
- my @lstatbuf = lstat *STDOUT{IO};
+ my @lstatbuf = lstat *FOO{IO};
is "@lstatbuf", "@statbuf", 'lstat $ioref reverts to regular fstat';
+ close(FOO);
+ unlink $tmpfile or print "# unlink failed: $!\n";
}
SKIP: {
my @b = (-M _, -A _, -C _);
print "# -MAC=(@b)\n";
ok( (-M _) < 0, 'negative -M works');
- ok( (-A _) < 0, 'negative -A works');
+ SKIP:
+ {
+ skip "Access timestamps inaccurate", 1 if $inaccurate_atime;
+ ok( (-A _) < 0, 'negative -A works');
+ }
ok( (-C _) < 0, 'negative -C works');
ok(unlink($f), 'unlink tmp file');
}
my $s2 = -s _;
is($s1, $s2, q(-T _ doesn't break the statbuffer));
SKIP: {
+ my $root_uid = $Is_Cygwin ? 18 : 0;
skip "No lstat", 1 unless $Config{d_lstat};
- skip "uid=0", 1 unless $<&&$>;
+ skip "uid=0", 1 if $< == $root_uid or $> == $root_uid;
+ skip "Can't check if admin user in miniperl", 1
+ if $^O =~ /^(cygwin|MSWin32|msys)$/ && is_miniperl();
+ skip "Readable by group/other means readable by me on $^O", 1 if $^O eq 'VMS'
+ or ($^O =~ /^(cygwin|MSWin32|msys)$/ and Win32::IsAdminUser());
lstat($tmpfile);
-T _;
ok(eval { lstat _ },
is $w, undef, 'no unopened warning from stat _';
}
+{
+ # [perl #123816]
+ # Inappropriate stacking of l?stat with filetests should either work or
+ # give a syntax error, they shouldn't crash.
+ eval { stat -t };
+ ok(1, 'can "stat -t" without crashing');
+ eval { lstat -t };
+ ok(1, 'can "lstat -t" without crashing');
+}
+
END {
chmod 0666, $tmpfile;
unlink_all $tmpfile;