Commit | Line | Data |
---|---|---|
b82fa0b7 | 1 | #!perl |
66375e66 NIS |
2 | |
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | } | |
7 | ||
b82fa0b7 | 8 | use strict; |
66375e66 NIS |
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 NIS |
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 CB |
24 | my $okstring = ''; |
25 | $okstring = "not " unless $test; | |
26 | $okstring .= "ok $test_num"; | |
27 | $okstring .= " - $name" if defined $name; | |
28 | print "$okstring\n"; | |
66375e66 NIS |
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 NIS |
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 NIS |
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 NIS |
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 NIS |
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 NIS |
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 NIS |
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 NIS |
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 NIS |
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 NIS |
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 NIS |
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 NIS |
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 NIS |
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 NIS |
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 NIS |
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 | } |