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