Commit | Line | Data |
33459055 |
1 | #!perl -w |
3f2ec160 |
2 | |
15db8fc4 |
3 | BEGIN { |
a9153838 |
4 | if( $ENV{PERL_CORE} ) { |
5 | chdir 't'; |
6 | @INC = ('../lib', 'lib'); |
7 | } |
8 | else { |
9 | unshift @INC, 't/lib'; |
10 | } |
15db8fc4 |
11 | } |
12 | |
33459055 |
13 | use strict; |
33459055 |
14 | |
15 | require Test::Simple::Catch; |
16 | my($out, $err) = Test::Simple::Catch::caught(); |
30e302f8 |
17 | local $ENV{HARNESS_ACTIVE} = 0; |
33459055 |
18 | |
19 | |
3f2ec160 |
20 | # Can't use Test.pm, that's a 5.005 thing. |
21 | package My::Test; |
22 | |
30e302f8 |
23 | print "1..12\n"; |
3f2ec160 |
24 | |
25 | my $test_num = 1; |
26 | # Utility testing functions. |
27 | sub ok ($;$) { |
28 | my($test, $name) = @_; |
1af51bd3 |
29 | my $ok = ''; |
30 | $ok .= "not " unless $test; |
31 | $ok .= "ok $test_num"; |
32 | $ok .= " - $name" if defined $name; |
33 | $ok .= "\n"; |
34 | print $ok; |
3f2ec160 |
35 | $test_num++; |
d020a79a |
36 | |
37 | return $test; |
3f2ec160 |
38 | } |
39 | |
40 | |
0257f296 |
41 | sub main::err_ok ($) { |
30e302f8 |
42 | my($expect) = @_; |
43 | my $got = $err->read; |
44 | |
45 | my $ok = ok( $got eq $expect ); |
46 | |
47 | unless( $ok ) { |
48 | print STDERR "$got\n"; |
49 | print STDERR "$expect\n"; |
50 | } |
51 | |
52 | return $ok; |
53 | } |
54 | |
55 | |
3f2ec160 |
56 | package main; |
d020a79a |
57 | |
3f2ec160 |
58 | require Test::More; |
30e302f8 |
59 | my $Total = 29; |
a9153838 |
60 | Test::More->import(tests => $Total); |
3f2ec160 |
61 | |
30e302f8 |
62 | my $tb = Test::More->builder; |
63 | $tb->use_numbers(0); |
64 | |
d020a79a |
65 | # Preserve the line numbers. |
33459055 |
66 | #line 38 |
3f2ec160 |
67 | ok( 0, 'failing' ); |
0257f296 |
68 | err_ok( <<ERR ); |
30e302f8 |
69 | # Failed test ($0 at line 38) |
70 | ERR |
a9153838 |
71 | |
72 | #line 40 |
73 | is( "foo", "bar", 'foo is bar?'); |
74 | is( undef, '', 'undef is empty string?'); |
75 | is( undef, 0, 'undef is 0?'); |
76 | is( '', 0, 'empty string is 0?' ); |
0257f296 |
77 | err_ok( <<ERR ); |
a9153838 |
78 | # Failed test ($0 at line 40) |
3f2ec160 |
79 | # got: 'foo' |
80 | # expected: 'bar' |
33459055 |
81 | # Failed test ($0 at line 41) |
a9153838 |
82 | # got: undef |
83 | # expected: '' |
84 | # Failed test ($0 at line 42) |
85 | # got: undef |
86 | # expected: '0' |
33459055 |
87 | # Failed test ($0 at line 43) |
a9153838 |
88 | # got: '' |
89 | # expected: '0' |
30e302f8 |
90 | ERR |
91 | |
92 | #line 45 |
93 | isnt("foo", "foo", 'foo isnt foo?' ); |
94 | isn't("foo", "foo",'foo isn\'t foo?' ); |
95 | isnt(undef, undef, 'undef isnt undef?'); |
0257f296 |
96 | err_ok( <<ERR ); |
a9153838 |
97 | # Failed test ($0 at line 45) |
98 | # 'foo' |
99 | # ne |
100 | # 'foo' |
101 | # Failed test ($0 at line 46) |
102 | # 'foo' |
103 | # ne |
104 | # 'foo' |
30e302f8 |
105 | # Failed test ($0 at line 47) |
106 | # undef |
107 | # ne |
108 | # undef |
109 | ERR |
110 | |
111 | #line 48 |
112 | like( "foo", '/that/', 'is foo like that' ); |
113 | unlike( "foo", '/foo/', 'is foo unlike foo' ); |
0257f296 |
114 | err_ok( <<ERR ); |
a9153838 |
115 | # Failed test ($0 at line 48) |
3f2ec160 |
116 | # 'foo' |
117 | # doesn't match '/that/' |
a9153838 |
118 | # Failed test ($0 at line 49) |
119 | # 'foo' |
120 | # matches '/foo/' |
30e302f8 |
121 | ERR |
122 | |
123 | # Nick Clark found this was a bug. Fixed in 0.40. |
124 | like( "bug", '/(%)/', 'regex with % in it' ); |
0257f296 |
125 | err_ok( <<ERR ); |
30e302f8 |
126 | # Failed test ($0 at line 60) |
a9153838 |
127 | # 'bug' |
128 | # doesn't match '/(%)/' |
30e302f8 |
129 | ERR |
130 | |
131 | fail('fail()'); |
0257f296 |
132 | err_ok( <<ERR ); |
30e302f8 |
133 | # Failed test ($0 at line 67) |
134 | ERR |
135 | |
136 | #line 52 |
137 | can_ok('Mooble::Hooble::Yooble', qw(this that)); |
138 | can_ok('Mooble::Hooble::Yooble', ()); |
0257f296 |
139 | err_ok( <<ERR ); |
a9153838 |
140 | # Failed test ($0 at line 52) |
d020a79a |
141 | # Mooble::Hooble::Yooble->can('this') failed |
142 | # Mooble::Hooble::Yooble->can('that') failed |
a9153838 |
143 | # Failed test ($0 at line 53) |
144 | # can_ok() called with no methods |
30e302f8 |
145 | ERR |
146 | |
147 | #line 55 |
148 | isa_ok(bless([], "Foo"), "Wibble"); |
149 | isa_ok(42, "Wibble", "My Wibble"); |
150 | isa_ok(undef, "Wibble", "Another Wibble"); |
151 | isa_ok([], "HASH"); |
0257f296 |
152 | err_ok( <<ERR ); |
a9153838 |
153 | # Failed test ($0 at line 55) |
6686786d |
154 | # The object isn't a 'Wibble' it's a 'Foo' |
a9153838 |
155 | # Failed test ($0 at line 56) |
33459055 |
156 | # My Wibble isn't a reference |
a9153838 |
157 | # Failed test ($0 at line 57) |
33459055 |
158 | # Another Wibble isn't defined |
a9153838 |
159 | # Failed test ($0 at line 58) |
6686786d |
160 | # The object isn't a 'HASH' it's a 'ARRAY' |
30e302f8 |
161 | ERR |
162 | |
163 | #line 68 |
164 | cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' ); |
165 | cmp_ok( 42.1, '==', 23, , ' ==' ); |
166 | cmp_ok( 42, '!=', 42 , ' !=' ); |
167 | cmp_ok( 1, '&&', 0 , ' &&' ); |
168 | cmp_ok( 42, '==', "foo", ' == with strings' ); |
169 | cmp_ok( 42, 'eq', "foo", ' eq with numbers' ); |
170 | cmp_ok( undef, 'eq', 'foo', ' eq with undef' ); |
0257f296 |
171 | err_ok( <<ERR ); |
a9153838 |
172 | # Failed test ($0 at line 68) |
173 | # got: 'foo' |
174 | # expected: 'bar' |
175 | # Failed test ($0 at line 69) |
176 | # got: 42.1 |
177 | # expected: 23 |
178 | # Failed test ($0 at line 70) |
179 | # '42' |
180 | # != |
181 | # '42' |
182 | # Failed test ($0 at line 71) |
183 | # '1' |
184 | # && |
185 | # '0' |
186 | # Failed test ($0 at line 72) |
187 | # got: 42 |
188 | # expected: 0 |
189 | # Failed test ($0 at line 73) |
190 | # got: '42' |
191 | # expected: 'foo' |
192 | # Failed test ($0 at line 74) |
193 | # got: undef |
194 | # expected: 'foo' |
30e302f8 |
195 | ERR |
196 | |
197 | # generate a $!, it changes its value by context. |
198 | -e "wibblehibble"; |
199 | my $Errno_Number = $!+0; |
200 | my $Errno_String = $!.''; |
201 | #line 80 |
202 | cmp_ok( $!, 'eq', '', ' eq with stringified errno' ); |
203 | cmp_ok( $!, '==', -1, ' eq with numerified errno' ); |
0257f296 |
204 | err_ok( <<ERR ); |
a9153838 |
205 | # Failed test ($0 at line 80) |
206 | # got: '$Errno_String' |
207 | # expected: '' |
208 | # Failed test ($0 at line 81) |
209 | # got: $Errno_Number |
210 | # expected: -1 |
3f2ec160 |
211 | ERR |
212 | |
30e302f8 |
213 | #line 84 |
214 | use_ok('Hooble::mooble::yooble'); |
215 | require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'); |
216 | |
217 | #line 88 |
218 | END { |
219 | My::Test::ok($$out eq <<OUT, 'failing output'); |
220 | 1..$Total |
221 | not ok - failing |
222 | not ok - foo is bar? |
223 | not ok - undef is empty string? |
224 | not ok - undef is 0? |
225 | not ok - empty string is 0? |
226 | not ok - foo isnt foo? |
227 | not ok - foo isn't foo? |
228 | not ok - undef isnt undef? |
229 | not ok - is foo like that |
230 | not ok - is foo unlike foo |
231 | not ok - regex with % in it |
232 | not ok - fail() |
233 | not ok - Mooble::Hooble::Yooble->can(...) |
234 | not ok - Mooble::Hooble::Yooble->can(...) |
235 | not ok - The object isa Wibble |
236 | not ok - My Wibble isa Wibble |
237 | not ok - Another Wibble isa Wibble |
238 | not ok - The object isa HASH |
239 | not ok - cmp_ok eq |
240 | not ok - == |
241 | not ok - != |
242 | not ok - && |
243 | not ok - == with strings |
244 | not ok - eq with numbers |
245 | not ok - eq with undef |
246 | not ok - eq with stringified errno |
247 | not ok - eq with numerified errno |
248 | not ok - use Hooble::mooble::yooble; |
249 | not ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble; |
250 | OUT |
251 | |
1af51bd3 |
252 | my $filename = quotemeta $0; |
3f2ec160 |
253 | my $more_err_re = <<ERR; |
a9153838 |
254 | # Failed test \\($filename at line 84\\) |
3f2ec160 |
255 | # Tried to use 'Hooble::mooble::yooble'. |
ea071790 |
256 | # Error: Can't locate Hooble.* in \\\@INC .* |
30e302f8 |
257 | # BEGIN failed--compilation aborted at $filename line 84. |
a9153838 |
258 | # Failed test \\($filename at line 85\\) |
3f2ec160 |
259 | # Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'. |
ea071790 |
260 | # Error: Can't locate ALL.* in \\\@INC .* |
a9153838 |
261 | # Looks like you failed $Total tests of $Total. |
3f2ec160 |
262 | ERR |
263 | |
30e302f8 |
264 | unless( My::Test::ok($$err =~ /^$more_err_re$/, |
d020a79a |
265 | 'failing errors') ) { |
a9153838 |
266 | print $$err; |
0257f296 |
267 | print "regex:\n"; |
268 | print $more_err_re; |
d020a79a |
269 | } |
3f2ec160 |
270 | |
271 | exit(0); |
272 | } |