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