1#!/usr/bin/perl -w
2
3use Test::More tests => 18;
4use Symbol;
5use Test::Builder;
6use Test::Builder::Tester;
7
8use 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 onward with the cut and paste
13
14# My brain is melting.  My brain is melting.  ETOOMANYLAYERSOFTESTING
15
16# create some private file handles
17my $output_handle = gensym;
18my $error_handle  = gensym;
19
20# and tie them to this package
21my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT";
22my $err = tie *$error_handle,  "Test::Builder::Tester::Tie", "STDERR";
23
24# ooooh, use the test suite
25my $t = Test::Builder->new;
26
27# remember the testing outputs
28my $original_output_handle;
29my $original_failure_handle;
30my $original_todo_handle;
31my $testing_num;
32my $original_harness_env;
33
34sub 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    # remember 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
62sub 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
94start_testing();
95$out->expect("ok 1 - foo");
96pass("foo");
97my_test_test("basic meta meta test");
98
99start_testing();
100$out->expect("not ok 1 - foo");
101$err->expect("#     Failed test ($0 at line ".line_num(+1).")");
102fail("foo");
103my_test_test("basic meta meta test 2");
104
105start_testing();
106$out->expect("ok 1 - bar");
107test_out("ok 1 - foo");
108pass("foo");
109test_test("bar");
110my_test_test("meta meta test with tbt");
111
112start_testing();
113$out->expect("ok 1 - bar");
114test_out("not ok 1 - foo");
115test_err("#     Failed test ($0 at line ".line_num(+1).")");
116fail("foo");
117test_test("bar");
118my_test_test("meta meta test with tbt2 ");
119
120####################################################################
121# Actual meta tests
122####################################################################
123
124# set up the outer wrapper again
125start_testing();
126$out->expect("ok 1 - bar");
127
128# set up what the inner wrapper expects
129test_out("ok 1 - foo");
130
131# the actual test function that we are testing
132ok("1","foo");
133
134# test the name
135test_test(name => "bar");
136
137# check that passed
138my_test_test("meta test name");
139
140####################################################################
141
142# set up the outer wrapper again
143start_testing();
144$out->expect("ok 1 - bar");
145
146# set up what the inner wrapper expects
147test_out("ok 1 - foo");
148
149# the actual test function that we are testing
150ok("1","foo");
151
152# test the name
153test_test(title => "bar");
154
155# check that passed
156my_test_test("meta test title");
157
158####################################################################
159
160# set up the outer wrapper again
161start_testing();
162$out->expect("ok 1 - bar");
163
164# set up what the inner wrapper expects
165test_out("ok 1 - foo");
166
167# the actual test function that we are testing
168ok("1","foo");
169
170# test the name
171test_test(label => "bar");
172
173# check that passed
174my_test_test("meta test title");
175
176####################################################################
177
178# set up the outer wrapper again
179start_testing();
180$out->expect("ok 1 - bar");
181
182# set up what the inner wrapper expects
183test_out("not ok 1 - foo this is wrong");
184test_fail(+3);
185
186# the actual test function that we are testing
187ok("0","foo");
188
189# test that we got what we expect, ignoring our is wrong
190test_test(skip_out => 1, name => "bar");
191
192# check that that passed
193my_test_test("meta test skip_out");
194
195####################################################################
196
197# set up the outer wrapper again
198start_testing();
199$out->expect("ok 1 - bar");
200
201# set up what the inner wrapper expects
202test_out("not ok 1 - foo");
203test_err("this is wrong");
204
205# the actual test function that we are testing
206ok("0","foo");
207
208# test that we got what we expect, ignoring err is wrong
209test_test(skip_err => 1, name => "bar");
210
211# diagnostics failing out
212# check that that passed
213my_test_test("meta test skip_err");
214
215####################################################################
216