forbid -l _ after -T _

[p5sagit/p5-mst-13.2.git] / t / op / stat.t

diff --git a/t/op/stat.t b/t/op/stat.t
index 2f18382..2f38719 100755 (executable)
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -3,15 +3,15 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
-    require './test.pl';
+    require './test.pl';       # for which_perl() etc
 }
 
 use Config;
 use File::Spec;
 
-plan tests => 69;
+plan tests => 74;
 
-my $Perl = which_perl;
+my $Perl = which_perl();
 
 $Is_Amiga   = $^O eq 'amigaos';
 $Is_Cygwin  = $^O eq 'cygwin';
@@ -49,7 +49,7 @@ SKIP: {
 }
 
 SKIP: {
-  skip "mtime and ctime not reliable", 2 
+  skip "mtime and ctime not reliable", 2
     if $Is_MSWin32 or $Is_NetWare or $Is_Cygwin or $Is_Dos;
 
   ok( $mtime,           'mtime' );
@@ -88,19 +88,23 @@ SKIP: {
 
     SKIP: {
         my $cwd = File::Spec->rel2abs($Curdir);
-        skip "Solaris tmpfs has different mtime/ctime link semantics", 2 
-                                     if $Is_Solaris and $cwd =~ m#^/tmp# and 
+        skip "Solaris tmpfs has different mtime/ctime link semantics", 2
+                                     if $Is_Solaris and $cwd =~ m#^/tmp# and
                                         $mtime && $mtime == $ctime;
         skip "AFS has different mtime/ctime link semantics", 2
                                      if $cwd =~ m#$Config{'afsroot'}/#;
         skip "AmigaOS has different mtime/ctime link semantics", 2
                                      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 ...
+        skip "No ctime concept on this OS", 2
+                                     if $Is_MSWin32;
         if( !ok($mtime, 'hard link mtime') ||
             !isnt($mtime, $ctime, 'hard link ctime != mtime') ) {
             print <<DIAG;
-# Check if you are on a tmpfs of some sort.  Building in /tmp sometimes 
-# has this problem.  Also building on the ClearCase VOBS filesystem may 
+# Check if you are on a tmpfs of some sort.  Building in /tmp sometimes
+# has this problem.  Also building on the ClearCase VOBS filesystem may
 # cause this failure.
 DIAG
         }
@@ -133,7 +137,7 @@ SKIP: {
         # Going to try to switch away from root.  Might not work.
         my $olduid = $>;
         eval { $> = 1; };
-        skip "Can't test -r or -w meaningfully if you're superuser", 2 
+        skip "Can't test -r or -w meaningfully if you're superuser", 2
           if $> == 0;
 
         SKIP: {
@@ -199,8 +203,8 @@ SKIP: {
     skip "/dev isn't available to test against", 3
       unless -d '/dev' && -r '/dev' && -x '/dev';
 
-    my $LS  = $Config{d_readlink} ? "ls -lL" : "ls -l"; 
-    my $CMD = "$LS /dev";
+    my $LS  = $Config{d_readlink} ? "ls -lL" : "ls -l";
+    my $CMD = "$LS /dev 2>/dev/null";
     my $DEV = qx($CMD);
 
     skip "$CMD failed", 3 if $DEV eq '';
@@ -210,10 +214,13 @@ SKIP: {
     skip "opendir failed: $!", 3 if @DEV == 0;
 
     # /dev/stdout might be either character special or a named pipe,
-    # depending on which OS and how are you running the test, so let's
-    # censor that one away.
-    $DEV =~ s{^[cp].+?\sstdout$}{}m;
+    # 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.
+    $DEV =~ s{^[cpls].+?\sstdout$}{}m;
     @DEV =  grep { $_ ne 'stdout' } @DEV;
+    $DEV =~ s{^[cpls].+?\sstderr$}{}m;
+    @DEV =  grep { $_ ne 'stderr' } @DEV;
 
     # /dev/printer is also naughty: in IRIX it shows up as
     # Srwx-----, not srwx------.
@@ -283,7 +290,7 @@ SKIP: {
         skip "Test uses unixisms", 2 if $Is_MSWin32 || $Is_NetWare;
         skip "No TTY to test -t with", 2 unless -e $TTY;
 
-        open(TTY, $TTY) || 
+        open(TTY, $TTY) ||
           warn "Can't open $TTY--run t/TEST outside of make.\n";
         ok(-t TTY,  '-t');
         ok(-c TTY,  'tty is -c');
@@ -300,6 +307,7 @@ SKIP: {
 my $Null = File::Spec->devnull;
 SKIP: {
     skip "No null device to test with", 1 unless -e $Null;
+    skip "We know Win32 thinks '$Null' is a TTY", 1 if $Is_MSWin32;
 
     open(NULL, $Null) or DIE("Can't open $Null: $!");
     ok(! -t NULL,   'null device is not a TTY');
@@ -369,3 +377,32 @@ unlink $tmpfile or print "# unlink failed: $!\n";
 my @r = \stat(".");
 is(scalar @r, 13,   'stat returns full 13 elements');
 
+SKIP: {
+    skip "No lstat", 2 unless $Config{d_lstat};
+
+    stat $0;
+    eval { lstat _ };
+    ok( $@ =~ /^The stat preceding lstat\(\) wasn't an lstat/,
+       'lstat _ croaks after stat' );
+    eval { -l _ };
+    ok( $@ =~ /^The stat preceding -l _ wasn't an lstat/,
+       '-l _ croaks after stat' );
+
+    eval { lstat STDIN };
+    ok( $@ =~ /^The stat preceding lstat\(\) wasn't an lstat/,
+       'lstat FILEHANDLE croaks' );
+
+    # bug id 20020124.004
+    # If we have d_lstat, we should have symlink()
+    my $linkname = 'dolzero';
+    symlink $0, $linkname or die "# Can't symlink $0: $!";
+    lstat $linkname;
+    -T _;
+    eval { lstat _ };
+    ok( $@ =~ /^The stat preceding lstat\(\) wasn't an lstat/,
+       'lstat croaks after -T _' );
+    eval { -l _ };
+    ok( $@ =~ /^The stat preceding -l _ wasn't an lstat/,
+       '-l _ croaks after -T _' );
+    unlink $linkname or print "# unlink $linkname failed: $!\n";
+}