Commit | Line | Data |
845d7e37 |
1 | #!/usr/bin/perl -w |
2 | |
c0888b21 |
3 | BEGIN { |
4 | if( $ENV{PERL_CORE} ) { |
5 | chdir 't'; |
6 | @INC = '../lib'; |
7 | } |
8 | } |
9 | |
845d7e37 |
10 | use Test::More tests => 8; |
11 | use Symbol; |
12 | use Test::Builder; |
13 | use Test::Builder::Tester; |
14 | |
15 | use strict; |
16 | |
17 | # argh! now we need to test the thing we're testing. Basically we need |
18 | # to pretty much reimplement the whole code again. This is very |
19 | # annoying but can't be avoided. And onwards with the cut and paste |
20 | |
21 | # My brain is melting. My brain is melting. ETOOMANYLAYERSOFTESTING |
22 | |
23 | # create some private file handles |
24 | my $output_handle = gensym; |
25 | my $error_handle = gensym; |
26 | |
27 | # and tie them to this package |
28 | my $out = tie *$output_handle, "Test::Tester::Tie", "STDOUT"; |
29 | my $err = tie *$error_handle, "Test::Tester::Tie", "STDERR"; |
30 | |
31 | # ooooh, use the test suite |
32 | my $t = Test::Builder->new; |
33 | |
34 | # remember the testing outputs |
35 | my $original_output_handle; |
36 | my $original_failure_handle; |
37 | my $original_todo_handle; |
38 | my $original_harness_env; |
39 | my $testing_num; |
40 | |
41 | sub start_testing |
42 | { |
43 | # remember what the handles were set to |
44 | $original_output_handle = $t->output(); |
45 | $original_failure_handle = $t->failure_output(); |
46 | $original_todo_handle = $t->todo_output(); |
47 | $original_harness_env = $ENV{HARNESS_ACTIVE}; |
48 | |
49 | # switch out to our own handles |
50 | $t->output($output_handle); |
51 | $t->failure_output($error_handle); |
52 | $t->todo_output($error_handle); |
53 | |
54 | $ENV{HARNESS_ACTIVE} = 0; |
55 | |
56 | # clear the expected list |
57 | $out->reset(); |
58 | $err->reset(); |
59 | |
60 | # remeber that we're testing |
61 | $testing_num = $t->current_test; |
62 | $t->current_test(0); |
63 | } |
64 | |
65 | # each test test is actually two tests. This is bad and wrong |
66 | # but makes blood come out of my ears if I don't at least simplify |
67 | # it a little this way |
68 | |
69 | sub my_test_test |
70 | { |
71 | my $text = shift; |
72 | local $^W = 0; |
73 | |
74 | # reset the outputs |
75 | $t->output($original_output_handle); |
76 | $t->failure_output($original_failure_handle); |
77 | $t->todo_output($original_todo_handle); |
78 | $ENV{HARNESS_ACTIVE} = $original_harness_env; |
79 | |
80 | # reset the number of tests |
81 | $t->current_test($testing_num); |
82 | |
83 | # check we got the same values |
84 | my $got; |
85 | my $wanted; |
86 | |
87 | # stdout |
88 | $t->ok($out->check, "STDOUT $text"); |
89 | |
90 | # stderr |
91 | $t->ok($err->check, "STDERR $text"); |
92 | } |
93 | |
94 | #################################################################### |
95 | # Meta meta tests |
96 | #################################################################### |
97 | |
98 | # this is a quick test to check the hack that I've just implemented |
99 | # actually does a cut down version of Test::Builder::Tester |
100 | |
101 | start_testing(); |
102 | $out->expect("ok 1 - foo"); |
103 | pass("foo"); |
104 | my_test_test("basic meta meta test"); |
105 | |
106 | start_testing(); |
107 | $out->expect("not ok 1 - foo"); |
108 | $err->expect("# Failed test ($0 at line ".line_num(+1).")"); |
109 | fail("foo"); |
110 | my_test_test("basic meta meta test 2"); |
111 | |
112 | start_testing(); |
113 | $out->expect("ok 1 - bar"); |
114 | test_out("ok 1 - foo"); |
115 | pass("foo"); |
116 | test_test("bar"); |
117 | my_test_test("meta meta test with tbt"); |
118 | |
119 | start_testing(); |
120 | $out->expect("ok 1 - bar"); |
121 | test_out("not ok 1 - foo"); |
122 | test_err("# Failed test ($0 at line ".line_num(+1).")"); |
123 | fail("foo"); |
124 | test_test("bar"); |
125 | my_test_test("meta meta test with tbt2 "); |
126 | |
127 | #################################################################### |