lib/Test/t/onfail.t

   1 # -*-perl-*-
   2
   3 use strict;
   4 use Test qw($ntest plan ok $TESTOUT $TESTERR);
   5 use vars qw($mycnt);
   6
   7 BEGIN { plan test => 6, onfail => \&myfail }
   8
   9 $mycnt = 0;
  10
  11 my $why = "zero != one";
  12 # sneak in a test that Test::Harness wont see
  13 open J, ">junk";
  14 $TESTOUT = *J{IO};
  15 $TESTERR = *J{IO};
  16 ok(0, 1, $why);
  17 $TESTOUT = *STDOUT{IO};
  18 $TESTERR = *STDERR{IO};
  19 close J;
  20 unlink "junk";
  21 $ntest = 1;
  22
  23 sub 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 }