xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/lib/Test/t/onfail.t (revision 0:68f95e015346)
1# -*-perl-*-
2
3use strict;
4use Test qw($ntest plan ok $TESTOUT $TESTERR);
5use vars qw($mycnt);
6
7BEGIN { plan test => 6, onfail => \&myfail }
8
9$mycnt = 0;
10
11my $why = "zero != one";
12# sneak in a test that Test::Harness wont see
13open J, ">junk";
14$TESTOUT = *J{IO};
15$TESTERR = *J{IO};
16ok(0, 1, $why);
17$TESTOUT = *STDOUT{IO};
18$TESTERR = *STDERR{IO};
19close J;
20unlink "junk";
21$ntest = 1;
22
23sub myfail {
24    my ($f) = @_;
25    ok(@$f, 1);
26
27    my $t = $$f[0];
28    ok($$t{diagnostic}, $why);
29    ok($$t{'package'}, 'main');
30    ok($$t{repetition}, 1);
31    ok($$t{result}, 0);
32    ok($$t{expected}, 1);
33}
34