1N/A#!./perl
1N/A
1N/A# There are few filetest operators that are portable enough to test.
1N/A# See pod/perlport.pod for details.
1N/A
1N/ABEGIN {
1N/A chdir 't' if -d 't';
1N/A @INC = '../lib';
1N/A require './test.pl';
1N/A}
1N/A
1N/Ause Config;
1N/Aplan(tests => 10);
1N/A
1N/Aok( -d 'op' );
1N/Aok( -f 'TEST' );
1N/Aok( !-f 'op' );
1N/Aok( !-d 'TEST' );
1N/Aok( -r 'TEST' );
1N/A
1N/A# make sure TEST is r-x
1N/Aeval { chmod 0555, 'TEST' or die "chmod 0555, 'TEST' failed: $!" };
1N/Achomp ($bad_chmod = $@);
1N/A
1N/A$oldeuid = $>; # root can read and write anything
1N/Aeval '$> = 1'; # so switch uid (may not be implemented)
1N/A
1N/Aprint "# oldeuid = $oldeuid, euid = $>\n";
1N/A
1N/ASKIP: {
1N/A if (!$Config{d_seteuid}) {
1N/A skip('no seteuid');
1N/A }
1N/A elsif ($Config{config_args} =~/Dmksymlinks/) {
1N/A skip('we cannot chmod symlinks');
1N/A }
1N/A elsif ($bad_chmod) {
1N/A skip( $bad_chmod );
1N/A }
1N/A else {
1N/A ok( !-w 'TEST' );
1N/A }
1N/A}
1N/A
1N/A# Scripts are not -x everywhere so cannot test that.
1N/A
1N/Aeval '$> = $oldeuid'; # switch uid back (may not be implemented)
1N/A
1N/A# this would fail for the euid 1
1N/A# (unless we have unpacked the source code as uid 1...)
1N/Aok( -r 'op' );
1N/A
1N/A# this would fail for the euid 1
1N/A# (unless we have unpacked the source code as uid 1...)
1N/ASKIP: {
1N/A if ($Config{d_seteuid}) {
1N/A ok( -w 'op' );
1N/A } else {
1N/A skip('no seteuid');
1N/A }
1N/A}
1N/A
1N/Aok( -x 'op' ); # Hohum. Are directories -x everywhere?
1N/A
1N/Ais( "@{[grep -r, qw(foo io noo op zoo)]}", "io op" );