[perl5.git] / cpan / Test / t / onfail.t

# -*-perl-*-

use strict;
use Test qw($ntest plan ok $TESTOUT $TESTERR);
use vars qw($mycnt);

BEGIN { plan test => 6, onfail => \&myfail }

$mycnt = 0;

my $why = "zero != one";
# sneak in a test that Test::Harness wont see
open J, ">junk";
$TESTOUT = *J{IO};
$TESTERR = *J{IO};
ok(0, 1, $why);
$TESTOUT = *STDOUT{IO};
$TESTERR = *STDERR{IO};
close J;
unlink "junk";
$ntest = 1;

sub myfail {
    my ($f) = @_;
    ok(@$f, 1);

    my $t = $$f[0];
    ok($$t{diagnostic}, $why);
    ok($$t{'package'}, 'main');
    ok($$t{repetition}, 1);
    ok($$t{result}, 0);
    ok($$t{expected}, 1);
}
Commit	Line	Data
809908f7 MS	1	# --perl--
	2
	3	use strict;
711cdd39	4	use Test qw($ntest plan ok $TESTOUT $TESTERR);
809908f7 MS	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};
711cdd39	15	$TESTERR = *J{IO};
809908f7 MS	16	ok(0, 1, $why);
809908f7 MS	17	$TESTOUT = *STDOUT{IO};
711cdd39	18	$TESTERR = *STDERR{IO};
809908f7 MS	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	}