X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Fstat.t;h=f00bd284ca86e38333026ebdf3edac22d0d53dd6;hb=21fa6956243df9cb622bebfa0934ea7923519b4f;hp=b863f98c808002b3b6cf2ea2f2e9b13f52f33540;hpb=a80d47c2f481402c370d7113267069d0c75ceeeb;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/stat.t b/t/op/stat.t index b863f98..f00bd28 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -9,7 +9,7 @@ BEGIN { use Config; use File::Spec; -plan tests => 78; +plan tests => 107; my $Perl = which_perl(); @@ -25,10 +25,12 @@ $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_Dosish = $Is_Dos || $Is_OS2 || $Is_MSWin32 || $Is_NetWare || $Is_Cygwin; -$Is_UFS = $Is_Darwin && (() = `df -t ufs .`) == 2; +$Is_UFS = $Is_Darwin && (() = `df -t ufs . 2>/dev/null`) == 2; my($DEV, $INO, $MODE, $NLINK, $UID, $GID, $RDEV, $SIZE, $ATIME, $MTIME, $CTIME, $BLKSIZE, $BLOCKS) = (0..12); @@ -39,7 +41,7 @@ my $Curdir = File::Spec->curdir; my $tmpfile = 'Op_stat.tmp'; my $tmpfile_link = $tmpfile.'2'; - +chmod 0666, $tmpfile; 1 while unlink $tmpfile; open(FOO, ">$tmpfile") || DIE("Can't open temp test file: $!"); close FOO; @@ -47,6 +49,8 @@ close FOO; open(FOO, ">$tmpfile") || DIE("Can't open temp test file: $!"); my($nlink, $mtime, $ctime) = (stat(FOO))[$NLINK, $MTIME, $CTIME]; + +#VMS Fix-me: nlink should work on VMS if applicable link support configured. SKIP: { skip "No link count", 1 if $Is_VMS; @@ -55,7 +59,7 @@ SKIP: { SKIP: { skip "mtime and ctime not reliable", 2 - if $Is_MSWin32 or $Is_NetWare or $Is_Cygwin or $Is_Dos or $Is_MacOS; + if $Is_MSWin32 or $Is_NetWare or $Is_Cygwin or $Is_Dos or $Is_MacOS or $Is_Darwin; ok( $mtime, 'mtime' ); is( $mtime, $ctime, 'mtime == ctime' ); @@ -69,7 +73,7 @@ sleep 3 if $funky_FAT_timestamps; print FOO "Now is the time for all good men to come to.\n"; close(FOO); -sleep 2 unless $funky_FAT_timestamps; +sleep 2; SKIP: { @@ -111,10 +115,11 @@ SKIP: { !isnt($mtime, $ctime, 'hard link ctime != mtime') ) { print STDERR <$tmpfile") || DIE("Can't open temp test file: $!"); +ok(-z \*F, '-z on empty filehandle'); +ok(! -s \*F, ' and -s'); close F; ok(-z $tmpfile, '-z on empty file'); @@ -132,6 +139,11 @@ open(F, ">$tmpfile") || DIE("Can't open temp test file: $!"); print F "hi\n"; close F; +open(F, "<$tmpfile") || DIE("Can't open temp test file: $!"); +ok(!-z *F, '-z on empty filehandle'); +ok( -s *F, ' and -s'); +close F; + ok(! -z $tmpfile, '-z on non-empty file'); ok(-s $tmpfile, ' and -s'); @@ -165,17 +177,12 @@ SKIP: { - -# in ms windows, $tmpfile inherits owner uid from directory -# not sure about os/2, but chown is harmless anyway -eval { chown $>,$tmpfile; 1 } or print "# $@" ; - ok(chmod(0700,$tmpfile), 'chmod 0700'); ok(-r $tmpfile, ' -r'); ok(-w $tmpfile, ' -w'); SKIP: { - skip "-x simply determins if a file ends in an executable suffix", 1 + skip "-x simply determines if a file ends in an executable suffix", 1 if $Is_Dosish || $Is_MacOS; ok(-x $tmpfile, ' -x'); @@ -211,6 +218,18 @@ SKIP: { if $Is_MSWin32 || $Is_NetWare || $Is_Dos; skip "/dev isn't available to test against", 6 unless -d '/dev' && -r '/dev' && -x '/dev'; + skip "Skipping: unexpected ls output in MP-RAS", 6 + if $Is_MPRAS; + + # VMS problem: If GNV or other UNIX like tool is installed, then + # sometimes Perl will find /bin/ls, and will try to run it. + # But since Perl on VMS does not know to run it under Bash, it will + # try to run the DCL verb LS. And if the VMS product Language + # Sensitive Editor is installed, or some other LS verb, that will + # be run instead. So do not do this until we can teach Perl + # when to use BASH on VMS. + skip "ls command not available to Perl in OpenVMS right now.", 6 + if $Is_VMS; my $LS = $Config{d_readlink} ? "ls -lL" : "ls -l"; my $CMD = "$LS /dev 2>/dev/null"; @@ -304,7 +323,7 @@ SKIP: { SKIP: { skip "These tests require a TTY", 4 if $ENV{PERL_SKIP_TTY_TEST}; - my $TTY = $^O eq 'rhapsody' ? "/dev/ttyp0" : "/dev/tty"; + my $TTY = $Is_Rhapsody ? "/dev/ttyp0" : "/dev/tty"; SKIP: { skip "Test uses unixisms", 2 if $Is_MSWin32 || $Is_NetWare; @@ -401,16 +420,22 @@ unlink $tmpfile or print "# unlink failed: $!\n"; my @r = \stat($Curdir); is(scalar @r, 13, 'stat returns full 13 elements'); +stat $0; +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' ); + +lstat $0; +eval { lstat _ }; +is( "$@", "", "lstat _ ok after lstat" ); +eval { -l _ }; +is( "$@", "", "-l _ ok after lstat" ); + SKIP: { - skip "No lstat", 4 unless $Config{d_lstat}; - - stat $0; - 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' ); + skip "No lstat", 2 unless $Config{d_lstat}; # bug id 20020124.004 # If we have d_lstat, we should have symlink() @@ -442,6 +467,70 @@ ok( (-A _) < 0, 'negative -A works'); ok( (-C _) < 0, 'negative -C works'); ok(unlink($f), 'unlink tmp file'); +{ + ok(open(F, ">", $tmpfile), 'can create temp file'); + close F; + chmod 0077, $tmpfile; + my @a = stat($tmpfile); + my $s1 = -s _; + -T _; + my $s2 = -s _; + is($s1, $s2, q(-T _ doesn't break the statbuffer)); + unlink $tmpfile; +} + +SKIP: { + skip "No dirfd()", 9 unless $Config{d_dirfd} || $Config{d_dir_dd_fd}; + ok(opendir(DIR, "."), 'Can open "." dir') || diag "Can't open '.': $!"; + ok(stat(DIR), "stat() on dirhandle works"); + ok(-d -r _ , "chained -x's on dirhandle"); + ok(-d DIR, "-d on a dirhandle works"); + + # And now for the ambigious bareword case + ok(open(DIR, "TEST"), 'Can open "TEST" dir') + || diag "Can't open 'TEST': $!"; + my $size = (stat(DIR))[7]; + ok(defined $size, "stat() on bareword works"); + is($size, -s "TEST", "size returned by stat of bareword is for the file"); + ok(-f _, "ambiguous bareword uses file handle, not dir handle"); + ok(-f DIR); + closedir DIR or die $!; + close DIR or die $!; +} + +{ + # RT #8244: *FILE{IO} does not behave like *FILE for stat() and -X() operators + ok(open(F, ">", $tmpfile), 'can create temp file'); + my @thwap = stat *F{IO}; + ok(@thwap, "stat(*F{IO}) works"); + ok( -f *F{IO} , "single file tests work with *F{IO}"); + close F; + unlink $tmpfile; + + #PVIO's hold dirhandle information, so let's test them too. + + SKIP: { + skip "No dirfd()", 9 unless $Config{d_dirfd} || $Config{d_dir_dd_fd}; + ok(opendir(DIR, "."), 'Can open "." dir') || diag "Can't open '.': $!"; + ok(stat(*DIR{IO}), "stat() on *DIR{IO} works"); + 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 + ok(open(DIR, "TEST"), 'Can open "TEST" dir') + || diag "Can't open 'TEST': $!"; + my $size = (stat(*DIR{IO}))[7]; + ok(defined $size, "stat() on *THINGY{IO} works"); + is($size, -s "TEST", + "size returned by stat of *THINGY{IO} is for the file"); + ok(-f _, "ambiguous *THINGY{IO} uses file handle, not dir handle"); + ok(-f *DIR{IO}); + closedir DIR or die $!; + close DIR or die $!; + } +} + END { + chmod 0666, $tmpfile; 1 while unlink $tmpfile; }