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