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 => 10); 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