Commit | Line | Data |
b82fa0b7 |
1 | #!perl |
66375e66 |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | } |
7 | |
b82fa0b7 |
8 | use strict; |
66375e66 |
9 | |
10 | # For shutting up Test::Harness. |
11 | package My::Dev::Null; |
12 | use Tie::Handle; |
b82fa0b7 |
13 | @My::Dev::Null::ISA = qw(Tie::StdHandle); |
66375e66 |
14 | |
15 | sub WRITE { } |
16 | |
17 | |
18 | package main; |
19 | |
20 | # Utility testing functions. |
21 | my $test_num = 1; |
22 | sub ok ($;$) { |
23 | my($test, $name) = @_; |
22458fee |
24 | my $okstring = ''; |
25 | $okstring = "not " unless $test; |
26 | $okstring .= "ok $test_num"; |
27 | $okstring .= " - $name" if defined $name; |
28 | print "$okstring\n"; |
66375e66 |
29 | $test_num++; |
30 | } |
31 | |
32 | sub eqhash { |
33 | my($a1, $a2) = @_; |
34 | return 0 unless keys %$a1 == keys %$a2; |
35 | |
36 | my $ok = 1; |
37 | foreach my $k (keys %$a1) { |
38 | $ok = $a1->{$k} eq $a2->{$k}; |
39 | last unless $ok; |
40 | } |
41 | |
42 | return $ok; |
43 | } |
44 | |
b82fa0b7 |
45 | use vars qw($Total_tests %samples); |
66375e66 |
46 | |
47 | my $loaded; |
48 | BEGIN { $| = 1; $^W = 1; } |
49 | END {print "not ok $test_num\n" unless $loaded;} |
50 | print "1..$Total_tests\n"; |
51 | use Test::Harness; |
52 | $loaded = 1; |
53 | ok(1, 'compile'); |
54 | ######################### End of black magic. |
55 | |
56 | BEGIN { |
57 | %samples = ( |
58 | simple => { |
59 | bonus => 0, |
60 | max => 5, |
b82fa0b7 |
61 | 'ok' => 5, |
66375e66 |
62 | files => 1, |
63 | bad => 0, |
64 | good => 1, |
65 | tests => 1, |
66 | sub_skipped=> 0, |
67 | skipped => 0, |
68 | }, |
69 | simple_fail => { |
70 | bonus => 0, |
71 | max => 5, |
b82fa0b7 |
72 | 'ok' => 3, |
66375e66 |
73 | files => 1, |
74 | bad => 1, |
75 | good => 0, |
76 | tests => 1, |
77 | sub_skipped => 0, |
78 | skipped => 0, |
79 | }, |
80 | descriptive => { |
81 | bonus => 0, |
82 | max => 5, |
b82fa0b7 |
83 | 'ok' => 5, |
66375e66 |
84 | files => 1, |
85 | bad => 0, |
86 | good => 1, |
87 | tests => 1, |
88 | sub_skipped=> 0, |
89 | skipped => 0, |
90 | }, |
91 | no_nums => { |
92 | bonus => 0, |
93 | max => 5, |
b82fa0b7 |
94 | 'ok' => 4, |
66375e66 |
95 | files => 1, |
96 | bad => 1, |
97 | good => 0, |
98 | tests => 1, |
99 | sub_skipped=> 0, |
100 | skipped => 0, |
101 | }, |
102 | todo => { |
103 | bonus => 1, |
104 | max => 5, |
b82fa0b7 |
105 | 'ok' => 5, |
66375e66 |
106 | files => 1, |
107 | bad => 0, |
108 | good => 1, |
109 | tests => 1, |
110 | sub_skipped=> 0, |
111 | skipped => 0, |
112 | }, |
113 | skip => { |
114 | bonus => 0, |
115 | max => 5, |
b82fa0b7 |
116 | 'ok' => 5, |
66375e66 |
117 | files => 1, |
118 | bad => 0, |
119 | good => 1, |
120 | tests => 1, |
121 | sub_skipped=> 1, |
122 | skipped => 0, |
123 | }, |
124 | bailout => 0, |
125 | combined => { |
126 | bonus => 1, |
127 | max => 10, |
b82fa0b7 |
128 | 'ok' => 8, |
66375e66 |
129 | files => 1, |
130 | bad => 1, |
131 | good => 0, |
132 | tests => 1, |
133 | sub_skipped=> 1, |
134 | skipped => 0 |
135 | }, |
136 | duplicates => { |
137 | bonus => 0, |
138 | max => 10, |
b82fa0b7 |
139 | 'ok' => 11, |
66375e66 |
140 | files => 1, |
141 | bad => 1, |
142 | good => 0, |
143 | tests => 1, |
144 | sub_skipped=> 0, |
145 | skipped => 0, |
146 | }, |
147 | header_at_end => { |
148 | bonus => 0, |
149 | max => 4, |
b82fa0b7 |
150 | 'ok' => 4, |
66375e66 |
151 | files => 1, |
152 | bad => 0, |
153 | good => 1, |
154 | tests => 1, |
155 | sub_skipped=> 0, |
156 | skipped => 0, |
157 | }, |
158 | skip_all => { |
159 | bonus => 0, |
160 | max => 0, |
b82fa0b7 |
161 | 'ok' => 0, |
66375e66 |
162 | files => 1, |
163 | bad => 0, |
164 | good => 1, |
165 | tests => 1, |
166 | sub_skipped=> 0, |
167 | skipped => 1, |
168 | }, |
169 | with_comments => { |
170 | bonus => 2, |
171 | max => 5, |
b82fa0b7 |
172 | 'ok' => 5, |
66375e66 |
173 | files => 1, |
174 | bad => 0, |
175 | good => 1, |
176 | tests => 1, |
177 | sub_skipped=> 0, |
178 | skipped => 0, |
179 | }, |
180 | ); |
181 | |
182 | $Total_tests = keys(%samples) + 1; |
183 | } |
184 | |
185 | tie *NULL, 'My::Dev::Null' or die $!; |
186 | |
187 | while (my($test, $expect) = each %samples) { |
b82fa0b7 |
188 | # _run_all_tests() runs the tests but skips the formatting. |
66375e66 |
189 | my($totals, $failed); |
190 | eval { |
b82fa0b7 |
191 | select NULL; # _run_all_tests() isn't as quiet as it should be. |
66375e66 |
192 | ($totals, $failed) = |
b82fa0b7 |
193 | Test::Harness::_run_all_tests("lib/sample-tests/$test"); |
66375e66 |
194 | }; |
195 | select STDOUT; |
196 | |
197 | unless( $@ ) { |
198 | ok( eqhash( $expect, {map { $_=>$totals->{$_} } keys %$expect} ), |
199 | $test ); |
200 | } |
201 | else { # special case for bailout |
202 | ok( ($test eq 'bailout' and $@ =~ /Further testing stopped: GERONI/i), |
203 | $test ); |
204 | } |
205 | } |