1b8851fccSafresh1# -*-perl-*- 2b8851fccSafresh1 3b8851fccSafresh1use strict; 4b8851fccSafresh1use Test qw($ntest plan ok $TESTOUT $TESTERR); 5b8851fccSafresh1 6b8851fccSafresh1BEGIN { plan test => 6, onfail => \&myfail } 7b8851fccSafresh1 8*5759b3d2Safresh1our $mycnt = 0; 9b8851fccSafresh1 10b8851fccSafresh1my $why = "zero != one"; 11b8851fccSafresh1# sneak in a test that Test::Harness wont see 12*5759b3d2Safresh1open J, ">", "junk"; 13b8851fccSafresh1$TESTOUT = *J{IO}; 14b8851fccSafresh1$TESTERR = *J{IO}; 15b8851fccSafresh1ok(0, 1, $why); 16b8851fccSafresh1$TESTOUT = *STDOUT{IO}; 17b8851fccSafresh1$TESTERR = *STDERR{IO}; 18b8851fccSafresh1close J; 19b8851fccSafresh1unlink "junk"; 20b8851fccSafresh1$ntest = 1; 21b8851fccSafresh1 22b8851fccSafresh1sub myfail { 23b8851fccSafresh1 my ($f) = @_; 24b8851fccSafresh1 ok(@$f, 1); 25b8851fccSafresh1 26b8851fccSafresh1 my $t = $$f[0]; 27b8851fccSafresh1 ok($$t{diagnostic}, $why); 28b8851fccSafresh1 ok($$t{'package'}, 'main'); 29b8851fccSafresh1 ok($$t{repetition}, 1); 30b8851fccSafresh1 ok($$t{result}, 0); 31b8851fccSafresh1 ok($$t{expected}, 1); 32b8851fccSafresh1} 33