use Config;
use File::Spec;
-plan tests => 73;
+plan tests => 69;
+
+my $Perl = which_perl;
$Is_Amiga = $^O eq 'amigaos';
$Is_Cygwin = $^O eq 'cygwin';
unlink $tmpfile;
-open(FOO, ">$tmpfile") || BAILOUT("Can't open temp test file: $!");
+open(FOO, ">$tmpfile") || DIE("Can't open temp test file: $!");
close FOO;
-open(FOO, ">$tmpfile") || BAILOUT("Can't open temp test file: $!");
+open(FOO, ">$tmpfile") || DIE("Can't open temp test file: $!");
my($nlink, $mtime, $ctime) = (stat(FOO))[$NLINK, $MTIME, $CTIME];
-is($nlink, 1, 'nlink on regular file');
+SKIP: {
+ skip "No link count", 1 if $Is_VMS;
+
+ is($nlink, 1, 'nlink on regular file');
+}
SKIP: {
skip "mtime and ctime not reliable", 2
SKIP: {
skip "No link count", 1 if $Config{dont_use_nlink};
+ skip "Cygwin9X fakes hard links by copying", 1
+ if $Config{myuname} =~ /^cygwin_(?:9\d|me)\b/i;
+
is($nlink, 2, 'Link count on hard linked file' );
}
}
# truncate and touch $tmpfile.
-open(F, ">$tmpfile") || BAILOUT("Can't open temp test file: $!");
+open(F, ">$tmpfile") || DIE("Can't open temp test file: $!");
close F;
ok(-z $tmpfile, '-z on empty file');
ok(! -s $tmpfile, ' and -s');
-open(F, ">$tmpfile") || BAILOUT("Can't open temp test file: $!");
+open(F, ">$tmpfile") || DIE("Can't open temp test file: $!");
print F "hi\n";
close F;
ok(! -e $tmpfile_link, ' -e on unlinked file');
SKIP: {
- skip "No character, socket or block special files", 7
+ skip "No character, socket or block special files", 3
if $Is_MSWin32 || $Is_NetWare || $Is_Dos;
- skip "/dev/ isn't available to test against", 7
- unless -d '/dev/' && -r '/dev/' && -x '/dev/';
-
- opendir DEV, "/dev/" or BAILOUT("Can't open /dev/: $!");
- my($cnt, $char, $sock, $block);
- $cnt = $char = $sock = $block = 0;
- foreach (readdir DEV) {
- my $file = "/dev/$_";
- $cnt++;
- $char++ if -c $file;
- $sock++ if -S $file;
- $block++ if -b $file;
- }
-
- isnt( $cnt, 0, 'Found some files in /dev/ to test against' );
- isnt( $char, 0, ' and some character special files' );
- isnt( $sock, 0, ' and some socket files' );
- isnt( $block, 0, ' and some block special files' );
- ok( $char < $cnt, " they're not all character special" );
- ok( $sock < $cnt, " they're not all sockets" );
- ok( $block < $cnt, " they're not all block special" );
+ 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 $DEV = qx($CMD);
+
+ skip "$CMD failed", 3 if $DEV eq '';
+
+ my @DEV = do { my $dev; opendir($dev, "/dev") ? readdir($dev) : () };
+
+ 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;
+ @DEV = grep { $_ ne 'stdout' } @DEV;
+
+ # 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;
+ @DEV = grep { ! m{^\..+$} } @DEV;
+
+ my $try = sub {
+ my @c1 = eval qq[\$DEV =~ /^$_[0].*/mg];
+ my @c2 = eval qq[grep { $_[1] "/dev/\$_" } \@DEV];
+ my $c1 = scalar @c1;
+ my $c2 = scalar @c2;
+ is($c1, $c2, "ls and $_[1] agreeing on /dev ($c1 $c2)");
+ };
+
+ $try->('b', '-b');
+ $try->('c', '-c');
+ $try->('s', '-S');
}
+ok(! -b $Curdir, '!-b cwd');
ok(! -c $Curdir, '!-c cwd');
ok(! -S $Curdir, '!-S cwd');
-ok(! -b $Curdir, '!-b cwd');
-
SKIP: {
- skip "No setuid", 3 if $Is_MPE or $Is_Amiga or $Is_Dosish or $Is_Cygwin;
-
my($cnt, $uid);
$cnt = $uid = 0;
}
closedir BIN;
- if( !isnt($cnt, 0, 'found some programs') ||
- !isnt($uid, 0, 'found some setuid programs') ||
- !ok($uid < $cnt, " they're not all setuid") )
- {
- print <<DIAG;
-# The above two tests assume that at least one of these directories
-# are readable, executable and contain at least one setuid file
-# (but aren't all setuid).
-# @bin
-DIAG
- }
+ skip "No setuid programs", 3 if $uid == 0;
+
+ isnt($cnt, 0, 'found some programs');
+ isnt($uid, 0, ' found some setuid programs');
+ ok($uid < $cnt, " they're not all setuid");
}
close(TTY);
}
ok(! -t TTY, '!-t on closed TTY filehandle');
- ok(-t, '-t on STDIN');
+
+ {
+ local $TODO = 'STDIN not a tty when output is to pipe' if $Is_VMS;
+ ok(-t, '-t on STDIN');
+ }
}
my $Null = File::Spec->devnull;
SKIP: {
skip "No null device to test with", 1 unless -e $Null;
- open(NULL, $Null) or BAIL_OUT("Can't open $Null: $!");
+ open(NULL, $Null) or DIE("Can't open $Null: $!");
ok(! -t NULL, 'null device is not a TTY');
close(NULL);
}
ok(-T 'op/stat.t', '-T');
ok(! -B 'op/stat.t', '!-B');
-ok(-B $^X, '-B');
-ok(! -T $^X, '!-T');
+ok(-B $Perl, '-B');
+ok(! -T $Perl, '!-T');
open(FOO,'op/stat.t');
SKIP: {
projects / p5sagit/p5-mst-13.2.git / blobdiff