1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215
|
#!/usr/bin/perl -w
use Test::More tests => 18;
use Symbol;
use Test::Builder;
use Test::Builder::Tester;
use strict;
# argh! now we need to test the thing we're testing. Basically we need
# to pretty much reimplement the whole code again. This is very
# annoying but can't be avoided. And onwards with the cut and paste
# My brain is melting. My brain is melting. ETOOMANYLAYERSOFTESTING
# create some private file handles
my $output_handle = gensym;
my $error_handle = gensym;
# and tie them to this package
my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT";
my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR";
# ooooh, use the test suite
my $t = Test::Builder->new;
# remember the testing outputs
my $original_output_handle;
my $original_failure_handle;
my $original_todo_handle;
my $testing_num;
my $original_harness_env;
sub start_testing
{
# remember what the handles were set to
$original_output_handle = $t->output();
$original_failure_handle = $t->failure_output();
$original_todo_handle = $t->todo_output();
$original_harness_env = $ENV{HARNESS_ACTIVE};
# switch out to our own handles
$t->output($output_handle);
$t->failure_output($error_handle);
$t->todo_output($error_handle);
$ENV{HARNESS_ACTIVE} = 0;
# clear the expected list
$out->reset();
$err->reset();
# remember that we're testing
$testing_num = $t->current_test;
$t->current_test(0);
}
# each test test is actually two tests. This is bad and wrong
# but makes blood come out of my ears if I don't at least simplify
# it a little this way
sub my_test_test
{
my $text = shift;
local $^W = 0;
# reset the outputs
$t->output($original_output_handle);
$t->failure_output($original_failure_handle);
$t->todo_output($original_todo_handle);
$ENV{HARNESS_ACTIVE} = $original_harness_env;
# reset the number of tests
$t->current_test($testing_num);
# check we got the same values
my $got;
my $wanted;
# stdout
$t->ok($out->check, "STDOUT $text");
# stderr
$t->ok($err->check, "STDERR $text");
}
####################################################################
# Meta meta tests
####################################################################
# this is a quick test to check the hack that I've just implemented
# actually does a cut down version of Test::Builder::Tester
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 ");
####################################################################
# Actual meta tests
####################################################################
# set up the outer wrapper again
start_testing();
$out->expect("ok 1 - bar");
# set up what the inner wrapper expects
test_out("ok 1 - foo");
# the actual test function that we are testing
ok("1","foo");
# test the name
test_test(name => "bar");
# check that passed
my_test_test("meta test name");
####################################################################
# set up the outer wrapper again
start_testing();
$out->expect("ok 1 - bar");
# set up what the inner wrapper expects
test_out("ok 1 - foo");
# the actual test function that we are testing
ok("1","foo");
# test the name
test_test(title => "bar");
# check that passed
my_test_test("meta test title");
####################################################################
# set up the outer wrapper again
start_testing();
$out->expect("ok 1 - bar");
# set up what the inner wrapper expects
test_out("ok 1 - foo");
# the actual test function that we are testing
ok("1","foo");
# test the name
test_test(label => "bar");
# check that passed
my_test_test("meta test title");
####################################################################
# set up the outer wrapper again
start_testing();
$out->expect("ok 1 - bar");
# set up what the inner wrapper expects
test_out("not ok 1 - foo this is wrong");
test_fail(+3);
# the actual test function that we are testing
ok("0","foo");
# test that we got what we expect, ignoring our is wrong
test_test(skip_out => 1, name => "bar");
# check that that passed
my_test_test("meta test skip_out");
####################################################################
# set up the outer wrapper again
start_testing();
$out->expect("ok 1 - bar");
# set up what the inner wrapper expects
test_out("not ok 1 - foo");
test_err("this is wrong");
# the actual test function that we are testing
ok("0","foo");
# test that we got what we expect, ignoring err is wrong
test_test(skip_err => 1, name => "bar");
# diagnostics failing out
# check that that passed
my_test_test("meta test skip_err");
####################################################################
|