1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate chdir 't' if -d 't'; 5*0Sstevel@tonic-gate @INC = '../lib'; 6*0Sstevel@tonic-gate} 7*0Sstevel@tonic-gate 8*0Sstevel@tonic-gateuse Config; 9*0Sstevel@tonic-gateuse Test::More tests => 15; 10*0Sstevel@tonic-gate 11*0Sstevel@tonic-gate# these two should be kept in sync with the pragma itself 12*0Sstevel@tonic-gate# if hint bits are changed there, other things *will* break 13*0Sstevel@tonic-gatemy $hint_bits = 0x00400000; 14*0Sstevel@tonic-gatemy $error = "filetest: the only implemented subpragma is 'access'.\n"; 15*0Sstevel@tonic-gate 16*0Sstevel@tonic-gate# can't use it yet, because of the import death 17*0Sstevel@tonic-gateok( require filetest, 'required pragma successfully' ); 18*0Sstevel@tonic-gate 19*0Sstevel@tonic-gate# and here's one culprit, right here 20*0Sstevel@tonic-gateeval { filetest->import('bad subpragma') }; 21*0Sstevel@tonic-gateis( $@, $error, 'filetest dies with bad subpragma on import' ); 22*0Sstevel@tonic-gate 23*0Sstevel@tonic-gateis( $^H & $hint_bits, 0, 'hint bits not set without pragma in place' ); 24*0Sstevel@tonic-gate 25*0Sstevel@tonic-gate# now try the normal usage 26*0Sstevel@tonic-gate# can't check $^H here; it's lexically magic (see perlvar) 27*0Sstevel@tonic-gate# the test harness unintentionally hoards the goodies for itself 28*0Sstevel@tonic-gateuse_ok( 'filetest', 'access' ); 29*0Sstevel@tonic-gate 30*0Sstevel@tonic-gate# and import again, to see it here 31*0Sstevel@tonic-gatefiletest->import('access'); 32*0Sstevel@tonic-gateok( $^H & $hint_bits, 'hint bits set with pragma loaded' ); 33*0Sstevel@tonic-gate 34*0Sstevel@tonic-gate# and now get rid of it 35*0Sstevel@tonic-gatefiletest->unimport('access'); 36*0Sstevel@tonic-gateis( $^H & $hint_bits, 0, 'hint bits not set with pragma unimported' ); 37*0Sstevel@tonic-gate 38*0Sstevel@tonic-gateeval { filetest->unimport() }; 39*0Sstevel@tonic-gateis( $@, $error, 'filetest dies without subpragma on unimport' ); 40*0Sstevel@tonic-gate 41*0Sstevel@tonic-gate# there'll be a compilation aborted failure here, with the eval string 42*0Sstevel@tonic-gateeval "no filetest 'fake pragma'"; 43*0Sstevel@tonic-gatelike( $@, qr/^$error/, 'filetest dies with bad subpragma on unuse' ); 44*0Sstevel@tonic-gate 45*0Sstevel@tonic-gateeval "use filetest 'bad subpragma'"; 46*0Sstevel@tonic-gatelike( $@, qr/^$error/, 'filetest dies with bad subpragma on use' ); 47*0Sstevel@tonic-gate 48*0Sstevel@tonic-gateeval "use filetest"; 49*0Sstevel@tonic-gatelike( $@, qr/^$error/, 'filetest dies with missing subpragma on use' ); 50*0Sstevel@tonic-gate 51*0Sstevel@tonic-gateeval "no filetest"; 52*0Sstevel@tonic-gatelike( $@, qr/^$error/, 'filetest dies with missing subpragma on unuse' ); 53*0Sstevel@tonic-gate 54*0Sstevel@tonic-gateSKIP: { 55*0Sstevel@tonic-gate # A real test for filetest. 56*0Sstevel@tonic-gate # This works for systems with /usr/bin/chflags (i.e. BSD4.4 systems). 57*0Sstevel@tonic-gate my $chflags = "/usr/bin/chflags"; 58*0Sstevel@tonic-gate my $tstfile = "filetest.tst"; 59*0Sstevel@tonic-gate skip("No $chflags available", 4) if !-x $chflags; 60*0Sstevel@tonic-gate 61*0Sstevel@tonic-gate my $skip_eff_user_tests = (!$Config{d_setreuid} && !$Config{d_setresuid}) 62*0Sstevel@tonic-gate || 63*0Sstevel@tonic-gate (!$Config{d_setregid} && !$Config{d_setresgid}); 64*0Sstevel@tonic-gate 65*0Sstevel@tonic-gate eval { 66*0Sstevel@tonic-gate if (!-e $tstfile) { 67*0Sstevel@tonic-gate open(T, ">$tstfile") or die "Can't create $tstfile: $!"; 68*0Sstevel@tonic-gate close T; 69*0Sstevel@tonic-gate } 70*0Sstevel@tonic-gate system($chflags, "uchg", $tstfile); 71*0Sstevel@tonic-gate die "Can't exec $chflags uchg" if $? != 0; 72*0Sstevel@tonic-gate }; 73*0Sstevel@tonic-gate skip("Errors in test using chflags: $@", 4) if $@; 74*0Sstevel@tonic-gate 75*0Sstevel@tonic-gate { 76*0Sstevel@tonic-gate use filetest 'access'; 77*0Sstevel@tonic-gate SKIP: { 78*0Sstevel@tonic-gate skip("No tests on effective user id", 1) 79*0Sstevel@tonic-gate if $skip_eff_user_tests; 80*0Sstevel@tonic-gate is(-w $tstfile, undef, "$tstfile should not be recognized as writable"); 81*0Sstevel@tonic-gate } 82*0Sstevel@tonic-gate is(-W $tstfile, undef, "$tstfile should not be recognized as writable"); 83*0Sstevel@tonic-gate } 84*0Sstevel@tonic-gate 85*0Sstevel@tonic-gate { 86*0Sstevel@tonic-gate no filetest 'access'; 87*0Sstevel@tonic-gate SKIP: { 88*0Sstevel@tonic-gate skip("No tests on effective user id", 1) 89*0Sstevel@tonic-gate if $skip_eff_user_tests; 90*0Sstevel@tonic-gate is(-w $tstfile, 1, "$tstfile should be recognized as writable"); 91*0Sstevel@tonic-gate } 92*0Sstevel@tonic-gate is(-W $tstfile, 1, "$tstfile should be recognized as writable"); 93*0Sstevel@tonic-gate } 94*0Sstevel@tonic-gate 95*0Sstevel@tonic-gate # cleanup 96*0Sstevel@tonic-gate system($chflags, "nouchg", $tstfile); 97*0Sstevel@tonic-gate unlink $tstfile; 98*0Sstevel@tonic-gate warn "Can't remove $tstfile: $!" if -e $tstfile; 99*0Sstevel@tonic-gate} 100