This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
stat.t, filetest.t: Actually gen rand file names
[perl5.git] / t / op / stat.t
index 5167655..db31487 100644 (file)
@@ -7,9 +7,20 @@ BEGIN {
 }
 
 use Config;
-use File::Spec;
 
-plan tests => 107;
+my ($Null, $Curdir);
+if(eval {require File::Spec; 1}) {
+    $Null = File::Spec->devnull;
+    $Curdir = File::Spec->curdir;
+} else {
+    die $@ unless is_miniperl();
+    $Curdir = '.';
+    diag("miniperl failed to load File::Spec, error is:\n$@");
+    diag("\ncontinuing, assuming '.' for current directory. Some tests will be skipped.");
+}
+
+
+plan tests => 112;
 
 my $Perl = which_perl();
 
@@ -27,21 +38,23 @@ $Is_DGUX    = $^O eq 'dgux';
 $Is_MPRAS   = $^O =~ /svr4/ && -f '/etc/.relid';
 $Is_Rhapsody= $^O eq 'rhapsody';
 
-$Is_Dosish  = $Is_Dos || $Is_OS2 || $Is_MSWin32 || $Is_NetWare || $Is_Cygwin;
+$Is_Dosish  = $Is_Dos || $Is_OS2 || $Is_MSWin32 || $Is_NetWare;
 
 $Is_UFS     = $Is_Darwin && (() = `df -t ufs . 2>/dev/null`) == 2;
 
+if ($Is_Cygwin) {
+  require Win32;
+  Win32->import;
+}
+
 my($DEV, $INO, $MODE, $NLINK, $UID, $GID, $RDEV, $SIZE,
    $ATIME, $MTIME, $CTIME, $BLKSIZE, $BLOCKS) = (0..12);
 
-my $Curdir = File::Spec->curdir;
-
-
 my $tmpfile = tempfile();
 my $tmpfile_link = tempfile();
 
 chmod 0666, $tmpfile;
-1 while unlink $tmpfile;
+unlink_all $tmpfile;
 open(FOO, ">$tmpfile") || DIE("Can't open temp test file: $!");
 close FOO;
 
@@ -100,6 +113,7 @@ SKIP: {
     }
 
     SKIP: {
+       skip_if_miniperl("File::Spec not built for minitest", 2);
         my $cwd = File::Spec->rel2abs($Curdir);
         skip "Solaris tmpfs has different mtime/ctime link semantics", 2
                                      if $Is_Solaris and $cwd =~ m#^/tmp# and
@@ -163,10 +177,10 @@ SKIP: {
         my $olduid = $>;
         eval { $> = 1; };
         skip "Can't test -r or -w meaningfully if you're superuser", 2
-          if $> == 0;
+          if ($Is_Cygwin ? Win32::IsAdminUser : $> == 0);
 
         SKIP: {
-            skip "Can't test -r meaningfully?", 1 if $Is_Dos || $Is_Cygwin;
+            skip "Can't test -r meaningfully?", 1 if $Is_Dos;
             ok(!-r $tmpfile,    "   -r");
         }
 
@@ -196,8 +210,8 @@ ok(  -f $tmpfile,   '   -f');
 ok(! -d $tmpfile,   '   !-d');
 
 # Is this portable?
-ok(  -d $Curdir,          '-d cwd' );
-ok(! -f $Curdir,          '!-f cwd' );
+ok(  -d '.',          '-d cwd' );
+ok(! -f '.',          '!-f cwd' );
 
 
 SKIP: {
@@ -347,7 +361,6 @@ 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;
@@ -359,7 +372,7 @@ SKIP: {
 
 
 # These aren't strictly "stat" calls, but so what?
-my $statfile = File::Spec->catfile($Curdir, 'op', 'stat.t');
+my $statfile = './op/stat.t';
 ok(  -T $statfile,    '-T');
 ok(! -B $statfile,    '!-B');
 
@@ -428,6 +441,12 @@ stat $0;
 eval { lstat _ };
 like( $@, qr/^The stat preceding lstat\(\) wasn't an lstat/,
     'lstat _ croaks after stat' );
+eval { lstat *_ };
+like( $@, qr/^The stat preceding lstat\(\) wasn't an lstat/,
+    'lstat *_ croaks after stat' );
+eval { lstat \*_ };
+like( $@, qr/^The stat preceding lstat\(\) wasn't an lstat/,
+    'lstat \*_ croaks after stat' );
 eval { -l _ };
 like( $@, qr/^The stat preceding -l _ wasn't an lstat/,
     '-l _ croaks after stat' );
@@ -437,14 +456,30 @@ eval { lstat _ };
 is( "$@", "", "lstat _ ok after lstat" );
 eval { -l _ };
 is( "$@", "", "-l _ ok after lstat" );
+
+lstat "test.pl";
+{
+    open my $fh, "test.pl";
+    stat *$fh{IO};
+    eval { lstat _ }
+}
+like $@, qr/^The stat preceding lstat\(\) wasn't an lstat at /,
+'stat $ioref resets stat type';
+
+{
+    my @statbuf = stat STDOUT;
+    stat "test.pl";
+    my @lstatbuf = lstat *STDOUT{IO};
+    is "@lstatbuf", "@statbuf", 'lstat $ioref reverts to regular fstat';
+}
   
 SKIP: {
     skip "No lstat", 2 unless $Config{d_lstat};
 
     # 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: $!";
+    my $linkname = 'stat-' . rand =~ y/.//dr;
+    symlink $Perl, $linkname or die "# Can't symlink $0: $!";
     lstat $linkname;
     -T _;
     eval { lstat _ };
@@ -475,6 +510,7 @@ SKIP: {
     ok(unlink($f), 'unlink tmp file');
 }
 
+# [perl #4253]
 {
     ok(open(F, ">", $tmpfile), 'can create temp file');
     close F;
@@ -484,6 +520,9 @@ SKIP: {
     -T _;
     my $s2 = -s _;
     is($s1, $s2, q(-T _ doesn't break the statbuffer));
+    lstat($tmpfile);
+    -T _;
+    ok(eval { lstat _ }, q(-T _ doesn't break lstat for unreadable file));
     unlink $tmpfile;
 }
 
@@ -494,7 +533,7 @@ SKIP: {
     ok(-d -r _ , "chained -x's on dirhandle"); 
     ok(-d DIR, "-d on a dirhandle works");
 
-    # And now for the ambigious bareword case
+    # And now for the ambiguous bareword case
     {
        no warnings 'deprecated';
        ok(open(DIR, "TEST"), 'Can open "TEST" dir')
@@ -527,7 +566,7 @@ SKIP: {
        ok(-d _ , "The special file handle _ is set correctly"); 
         ok(-d -r *DIR{IO} , "chained -x's on *DIR{IO}");
 
-       # And now for the ambigious bareword case
+       # And now for the ambiguous bareword case
        {
            no warnings 'deprecated';
            ok(open(DIR, "TEST"), 'Can open "TEST" dir')
@@ -546,5 +585,5 @@ SKIP: {
 
 END {
     chmod 0666, $tmpfile;
-    1 while unlink $tmpfile;
+    unlink_all $tmpfile;
 }