#!/usr/bin/perl -w
my
$output_handle
= gensym;
my
$error_handle
= gensym;
my
$out
=
tie
*$output_handle
,
"Test::Builder::Tester::Tie"
,
"STDOUT"
;
my
$err
=
tie
*$error_handle
,
"Test::Builder::Tester::Tie"
,
"STDERR"
;
my
$t
= Test::Builder->new;
my
$original_output_handle
;
my
$original_failure_handle
;
my
$original_todo_handle
;
my
$original_harness_env
;
my
$testing_num
;
sub
start_testing
{
$original_output_handle
=
$t
->output();
$original_failure_handle
=
$t
->failure_output();
$original_todo_handle
=
$t
->todo_output();
$original_harness_env
=
$ENV
{HARNESS_ACTIVE};
$t
->output(
$output_handle
);
$t
->failure_output(
$error_handle
);
$t
->todo_output(
$error_handle
);
$ENV
{HARNESS_ACTIVE} = 0;
$out
->
reset
();
$err
->
reset
();
$testing_num
=
$t
->current_test;
$t
->current_test(0);
}
sub
my_test_test
{
my
$text
=
shift
;
local
$^W = 0;
$t
->output(
$original_output_handle
);
$t
->failure_output(
$original_failure_handle
);
$t
->todo_output(
$original_todo_handle
);
$ENV
{HARNESS_ACTIVE} =
$original_harness_env
;
$t
->current_test(
$testing_num
);
my
$got
;
my
$wanted
;
$t
->ok(
$out
->check,
"STDOUT $text"
);
$t
->ok(
$err
->check,
"STDERR $text"
);
}
start_testing();
$out
->expect(
"ok 1 - foo"
);
pass(
"foo"
);
my_test_test(
"basic meta meta test"
);
start_testing();
$out
->expect(
"not ok 1 - foo"
);
$err
->expect(
"# Failed test ($0 at line "
.line_num(+1).
")"
);
fail(
"foo"
);
my_test_test(
"basic meta meta test 2"
);
start_testing();
$out
->expect(
"ok 1 - bar"
);
test_out(
"ok 1 - foo"
);
pass(
"foo"
);
test_test(
"bar"
);
my_test_test(
"meta meta test with tbt"
);
start_testing();
$out
->expect(
"ok 1 - bar"
);
test_out(
"not ok 1 - foo"
);
test_err(
"# Failed test ($0 at line "
.line_num(+1).
")"
);
fail(
"foo"
);
test_test(
"bar"
);
my_test_test(
"meta meta test with tbt2 "
);