1#!./perl 2 3# There are few filetest operators that are portable enough to test. 4# See pod/perlport.pod for details. 5 6BEGIN { 7 chdir 't' if -d 't'; 8 @INC = '../lib'; 9 require './test.pl'; 10} 11 12use Config; 13plan(tests => 28); 14 15ok( -d 'op' ); 16ok( -f 'TEST' ); 17ok( !-f 'op' ); 18ok( !-d 'TEST' ); 19ok( -r 'TEST' ); 20 21# make sure TEST is r-x 22eval { chmod 0555, 'TEST' or die "chmod 0555, 'TEST' failed: $!" }; 23chomp ($bad_chmod = $@); 24 25$oldeuid = $>; # root can read and write anything 26eval '$> = 1'; # so switch uid (may not be implemented) 27 28print "# oldeuid = $oldeuid, euid = $>\n"; 29 30SKIP: { 31 if (!$Config{d_seteuid}) { 32 skip('no seteuid'); 33 } 34 elsif ($Config{config_args} =~/Dmksymlinks/) { 35 skip('we cannot chmod symlinks'); 36 } 37 elsif ($bad_chmod) { 38 skip( $bad_chmod ); 39 } 40 else { 41 ok( !-w 'TEST' ); 42 } 43} 44 45# Scripts are not -x everywhere so cannot test that. 46 47eval '$> = $oldeuid'; # switch uid back (may not be implemented) 48 49# this would fail for the euid 1 50# (unless we have unpacked the source code as uid 1...) 51ok( -r 'op' ); 52 53# this would fail for the euid 1 54# (unless we have unpacked the source code as uid 1...) 55SKIP: { 56 if ($Config{d_seteuid}) { 57 ok( -w 'op' ); 58 } else { 59 skip('no seteuid'); 60 } 61} 62 63ok( -x 'op' ); # Hohum. Are directories -x everywhere? 64 65is( "@{[grep -r, qw(foo io noo op zoo)]}", "io op" ); 66 67# Test stackability of filetest operators 68 69ok( defined( -f -d 'TEST' ) && ! -f -d _ ); 70ok( !defined( -e 'zoo' ) ); 71ok( !defined( -e -d 'zoo' ) ); 72ok( !defined( -f -e 'zoo' ) ); 73ok( -f -e 'TEST' ); 74ok( -e -f 'TEST' ); 75ok( defined(-d -e 'TEST') ); 76ok( defined(-e -d 'TEST') ); 77ok( ! -f -d 'op' ); 78ok( -x -d -x 'op' ); 79ok( (-s -f 'TEST' > 1), "-s returns real size" ); 80ok( -f -s 'TEST' == 1 ); 81 82# now with an empty file 83my $tempfile = tempfile(); 84open my $fh, ">", $tempfile; 85close $fh; 86ok( -f $tempfile ); 87is( -s $tempfile, 0 ); 88is( -f -s $tempfile, 0 ); 89is( -s -f $tempfile, 0 ); 90unlink $tempfile; 91 92# test that _ is a bareword after filetest operators 93 94-f 'TEST'; 95ok( -f _ ); 96sub _ { "this is not a file name" } 97ok( -f _ ); 98