1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gate# There are few filetest operators that are portable enough to test. 4*0Sstevel@tonic-gate# See pod/perlport.pod for details. 5*0Sstevel@tonic-gate 6*0Sstevel@tonic-gateBEGIN { 7*0Sstevel@tonic-gate chdir 't' if -d 't'; 8*0Sstevel@tonic-gate @INC = '../lib'; 9*0Sstevel@tonic-gate require './test.pl'; 10*0Sstevel@tonic-gate} 11*0Sstevel@tonic-gate 12*0Sstevel@tonic-gateuse Config; 13*0Sstevel@tonic-gateplan(tests => 10); 14*0Sstevel@tonic-gate 15*0Sstevel@tonic-gateok( -d 'op' ); 16*0Sstevel@tonic-gateok( -f 'TEST' ); 17*0Sstevel@tonic-gateok( !-f 'op' ); 18*0Sstevel@tonic-gateok( !-d 'TEST' ); 19*0Sstevel@tonic-gateok( -r 'TEST' ); 20*0Sstevel@tonic-gate 21*0Sstevel@tonic-gate# make sure TEST is r-x 22*0Sstevel@tonic-gateeval { chmod 0555, 'TEST' or die "chmod 0555, 'TEST' failed: $!" }; 23*0Sstevel@tonic-gatechomp ($bad_chmod = $@); 24*0Sstevel@tonic-gate 25*0Sstevel@tonic-gate$oldeuid = $>; # root can read and write anything 26*0Sstevel@tonic-gateeval '$> = 1'; # so switch uid (may not be implemented) 27*0Sstevel@tonic-gate 28*0Sstevel@tonic-gateprint "# oldeuid = $oldeuid, euid = $>\n"; 29*0Sstevel@tonic-gate 30*0Sstevel@tonic-gateSKIP: { 31*0Sstevel@tonic-gate if (!$Config{d_seteuid}) { 32*0Sstevel@tonic-gate skip('no seteuid'); 33*0Sstevel@tonic-gate } 34*0Sstevel@tonic-gate elsif ($Config{config_args} =~/Dmksymlinks/) { 35*0Sstevel@tonic-gate skip('we cannot chmod symlinks'); 36*0Sstevel@tonic-gate } 37*0Sstevel@tonic-gate elsif ($bad_chmod) { 38*0Sstevel@tonic-gate skip( $bad_chmod ); 39*0Sstevel@tonic-gate } 40*0Sstevel@tonic-gate else { 41*0Sstevel@tonic-gate ok( !-w 'TEST' ); 42*0Sstevel@tonic-gate } 43*0Sstevel@tonic-gate} 44*0Sstevel@tonic-gate 45*0Sstevel@tonic-gate# Scripts are not -x everywhere so cannot test that. 46*0Sstevel@tonic-gate 47*0Sstevel@tonic-gateeval '$> = $oldeuid'; # switch uid back (may not be implemented) 48*0Sstevel@tonic-gate 49*0Sstevel@tonic-gate# this would fail for the euid 1 50*0Sstevel@tonic-gate# (unless we have unpacked the source code as uid 1...) 51*0Sstevel@tonic-gateok( -r 'op' ); 52*0Sstevel@tonic-gate 53*0Sstevel@tonic-gate# this would fail for the euid 1 54*0Sstevel@tonic-gate# (unless we have unpacked the source code as uid 1...) 55*0Sstevel@tonic-gateSKIP: { 56*0Sstevel@tonic-gate if ($Config{d_seteuid}) { 57*0Sstevel@tonic-gate ok( -w 'op' ); 58*0Sstevel@tonic-gate } else { 59*0Sstevel@tonic-gate skip('no seteuid'); 60*0Sstevel@tonic-gate } 61*0Sstevel@tonic-gate} 62*0Sstevel@tonic-gate 63*0Sstevel@tonic-gateok( -x 'op' ); # Hohum. Are directories -x everywhere? 64*0Sstevel@tonic-gate 65*0Sstevel@tonic-gateis( "@{[grep -r, qw(foo io noo op zoo)]}", "io op" ); 66