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 => 18; |
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 $testing_num; |
39 | my $original_harness_env; |
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 | #################################################################### |
128 | # Actual meta tests |
129 | #################################################################### |
130 | |
131 | # set up the outer wrapper again |
132 | start_testing(); |
133 | $out->expect("ok 1 - bar"); |
134 | |
135 | # set up what the inner wrapper expects |
136 | test_out("ok 1 - foo"); |
137 | |
138 | # the actual test function that we are testing |
139 | ok("1","foo"); |
140 | |
141 | # test the name |
142 | test_test(name => "bar"); |
143 | |
144 | # check that passed |
145 | my_test_test("meta test name"); |
146 | |
147 | #################################################################### |
148 | |
149 | # set up the outer wrapper again |
150 | start_testing(); |
151 | $out->expect("ok 1 - bar"); |
152 | |
153 | # set up what the inner wrapper expects |
154 | test_out("ok 1 - foo"); |
155 | |
156 | # the actual test function that we are testing |
157 | ok("1","foo"); |
158 | |
159 | # test the name |
160 | test_test(title => "bar"); |
161 | |
162 | # check that passed |
163 | my_test_test("meta test title"); |
164 | |
165 | #################################################################### |
166 | |
167 | # set up the outer wrapper again |
168 | start_testing(); |
169 | $out->expect("ok 1 - bar"); |
170 | |
171 | # set up what the inner wrapper expects |
172 | test_out("ok 1 - foo"); |
173 | |
174 | # the actual test function that we are testing |
175 | ok("1","foo"); |
176 | |
177 | # test the name |
178 | test_test(label => "bar"); |
179 | |
180 | # check that passed |
181 | my_test_test("meta test title"); |
182 | |
183 | #################################################################### |
184 | |
185 | # set up the outer wrapper again |
186 | start_testing(); |
187 | $out->expect("ok 1 - bar"); |
188 | |
189 | # set up what the inner wrapper expects |
190 | test_out("not ok 1 - foo this is wrong"); |
191 | test_fail(+3); |
192 | |
193 | # the actual test function that we are testing |
194 | ok("0","foo"); |
195 | |
196 | # test that we got what we expect, ignoring our is wrong |
197 | test_test(skip_out => 1, name => "bar"); |
198 | |
199 | # check that that passed |
200 | my_test_test("meta test skip_out"); |
201 | |
202 | #################################################################### |
203 | |
204 | # set up the outer wrapper again |
205 | start_testing(); |
206 | $out->expect("ok 1 - bar"); |
207 | |
208 | # set up what the inner wrapper expects |
209 | test_out("not ok 1 - foo"); |
210 | test_err("this is wrong"); |
211 | |
212 | # the actual test function that we are testing |
213 | ok("0","foo"); |
214 | |
215 | # test that we got what we expect, ignoring err is wrong |
216 | test_test(skip_err => 1, name => "bar"); |
217 | |
218 | # diagnostics failing out |
219 | # check that that passed |
220 | my_test_test("meta test skip_err"); |
221 | |
222 | #################################################################### |