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} 10 11use Config; 12print "1..10\n"; 13 14print "not " unless -d 'op'; 15print "ok 1\n"; 16 17print "not " unless -f 'TEST'; 18print "ok 2\n"; 19 20print "not " if -f 'op'; 21print "ok 3\n"; 22 23print "not " if -d 'TEST'; 24print "ok 4\n"; 25 26print "not " unless -r 'TEST'; 27print "ok 5\n"; 28 29# make sure TEST is r-x 30eval { chmod 0555, 'TEST' }; 31$bad_chmod = $@; 32 33$oldeuid = $>; # root can read and write anything 34eval '$> = 1'; # so switch uid (may not be implemented) 35 36print "# oldeuid = $oldeuid, euid = $>\n"; 37 38if (!$Config{d_seteuid}) { 39 print "ok 6 #skipped, no seteuid\n"; 40} 41elsif ($bad_chmod) { 42 print "#[$@]\nok 6 #skipped\n"; 43} 44else { 45 print "not " if -w 'TEST'; 46 print "ok 6\n"; 47} 48 49# Scripts are not -x everywhere so cannot test that. 50 51eval '$> = $oldeuid'; # switch uid back (may not be implemented) 52 53# this would fail for the euid 1 54# (unless we have unpacked the source code as uid 1...) 55print "not " unless -r 'op'; 56print "ok 7\n"; 57 58# this would fail for the euid 1 59# (unless we have unpacked the source code as uid 1...) 60if ($Config{d_seteuid}) { 61 print "not " unless -w 'op'; 62 print "ok 8\n"; 63} else { 64 print "ok 8 #skipped, no seteuid\n"; 65} 66 67print "not " unless -x 'op'; # Hohum. Are directories -x everywhere? 68print "ok 9\n"; 69 70print "not " unless "@{[grep -r, qw(foo io noo op zoo)]}" eq "io op"; 71print "ok 10\n"; 72