[perl #105922] Allow any string before ->meth
[perl.git] / cpan / Test-Simple / t / fail-more.t
1 #!perl -w
2
3 BEGIN {
4     if( $ENV{PERL_CORE} ) {
5         chdir 't';
6         @INC = ('../lib', 'lib');
7     }
8     else {
9         unshift @INC, 't/lib';
10     }
11 }
12
13 use strict;
14
15 require Test::Simple::Catch;
16 my($out, $err) = Test::Simple::Catch::caught();
17 local $ENV{HARNESS_ACTIVE} = 0;
18
19
20 # Can't use Test.pm, that's a 5.005 thing.
21 package My::Test;
22
23 # This has to be a require or else the END block below runs before
24 # Test::Builder's own and the ending diagnostics don't come out right.
25 require Test::Builder;
26 my $TB = Test::Builder->create;
27 $TB->plan(tests => 80);
28
29 sub like ($$;$) {
30     $TB->like(@_);
31 }
32
33 sub is ($$;$) {
34     $TB->is_eq(@_);
35 }
36
37 sub main::out_ok ($$) {
38     $TB->is_eq( $out->read, shift );
39     $TB->is_eq( $err->read, shift );
40 }
41
42 sub main::out_like ($$) {
43     my($output, $failure) = @_;
44
45     $TB->like( $out->read, qr/$output/ );
46     $TB->like( $err->read, qr/$failure/ );
47 }
48
49
50 package main;
51
52 require Test::More;
53 our $TODO;
54 my $Total = 38;
55 Test::More->import(tests => $Total);
56 $out->read;  # clear the plan from $out
57
58 # This should all work in the presence of a __DIE__ handler.
59 local $SIG{__DIE__} = sub { $TB->ok(0, "DIE handler called: ".join "", @_); };
60
61
62 my $tb = Test::More->builder;
63 $tb->use_numbers(0);
64
65 my $Filename = quotemeta $0;
66
67
68 #line 38
69 ok( 0, 'failing' );
70 out_ok( <<OUT, <<ERR );
71 not ok - failing
72 OUT
73 #   Failed test 'failing'
74 #   at $0 line 38.
75 ERR
76
77
78 #line 40
79 is( "foo", "bar", 'foo is bar?');
80 out_ok( <<OUT, <<ERR );
81 not ok - foo is bar?
82 OUT
83 #   Failed test 'foo is bar?'
84 #   at $0 line 40.
85 #          got: 'foo'
86 #     expected: 'bar'
87 ERR
88
89 #line 89
90 is( undef, '',    'undef is empty string?');
91 out_ok( <<OUT, <<ERR );
92 not ok - undef is empty string?
93 OUT
94 #   Failed test 'undef is empty string?'
95 #   at $0 line 89.
96 #          got: undef
97 #     expected: ''
98 ERR
99
100 #line 99
101 is( undef, 0,     'undef is 0?');
102 out_ok( <<OUT, <<ERR );
103 not ok - undef is 0?
104 OUT
105 #   Failed test 'undef is 0?'
106 #   at $0 line 99.
107 #          got: undef
108 #     expected: '0'
109 ERR
110
111 #line 110
112 is( '',    0,     'empty string is 0?' );
113 out_ok( <<OUT, <<ERR );
114 not ok - empty string is 0?
115 OUT
116 #   Failed test 'empty string is 0?'
117 #   at $0 line 110.
118 #          got: ''
119 #     expected: '0'
120 ERR
121
122 #line 121
123 isnt("foo", "foo", 'foo isnt foo?' );
124 out_ok( <<OUT, <<ERR );
125 not ok - foo isnt foo?
126 OUT
127 #   Failed test 'foo isnt foo?'
128 #   at $0 line 121.
129 #          got: 'foo'
130 #     expected: anything else
131 ERR
132
133 #line 132
134 isn't("foo", "foo",'foo isn\'t foo?' );
135 out_ok( <<OUT, <<ERR );
136 not ok - foo isn't foo?
137 OUT
138 #   Failed test 'foo isn\'t foo?'
139 #   at $0 line 132.
140 #          got: 'foo'
141 #     expected: anything else
142 ERR
143
144 #line 143
145 isnt(undef, undef, 'undef isnt undef?');
146 out_ok( <<OUT, <<ERR );
147 not ok - undef isnt undef?
148 OUT
149 #   Failed test 'undef isnt undef?'
150 #   at $0 line 143.
151 #          got: undef
152 #     expected: anything else
153 ERR
154
155 #line 154
156 like( "foo", '/that/',  'is foo like that' );
157 out_ok( <<OUT, <<ERR );
158 not ok - is foo like that
159 OUT
160 #   Failed test 'is foo like that'
161 #   at $0 line 154.
162 #                   'foo'
163 #     doesn't match '/that/'
164 ERR
165
166 #line 165
167 unlike( "foo", '/foo/', 'is foo unlike foo' );
168 out_ok( <<OUT, <<ERR );
169 not ok - is foo unlike foo
170 OUT
171 #   Failed test 'is foo unlike foo'
172 #   at $0 line 165.
173 #                   'foo'
174 #           matches '/foo/'
175 ERR
176
177 # Nick Clark found this was a bug.  Fixed in 0.40.
178 # line 177
179 like( "bug", '/(%)/',   'regex with % in it' );
180 out_ok( <<OUT, <<ERR );
181 not ok - regex with % in it
182 OUT
183 #   Failed test 'regex with % in it'
184 #   at $0 line 177.
185 #                   'bug'
186 #     doesn't match '/(%)/'
187 ERR
188
189 #line 188
190 fail('fail()');
191 out_ok( <<OUT, <<ERR );
192 not ok - fail()
193 OUT
194 #   Failed test 'fail()'
195 #   at $0 line 188.
196 ERR
197
198 #line 197
199 can_ok('Mooble::Hooble::Yooble', qw(this that));
200 out_ok( <<OUT, <<ERR );
201 not ok - Mooble::Hooble::Yooble->can(...)
202 OUT
203 #   Failed test 'Mooble::Hooble::Yooble->can(...)'
204 #   at $0 line 197.
205 #     Mooble::Hooble::Yooble->can('this') failed
206 #     Mooble::Hooble::Yooble->can('that') failed
207 ERR
208
209 #line 208
210 can_ok('Mooble::Hooble::Yooble', ());
211 out_ok( <<OUT, <<ERR );
212 not ok - Mooble::Hooble::Yooble->can(...)
213 OUT
214 #   Failed test 'Mooble::Hooble::Yooble->can(...)'
215 #   at $0 line 208.
216 #     can_ok() called with no methods
217 ERR
218
219 #line 218
220 can_ok(undef, undef);
221 out_ok( <<OUT, <<ERR );
222 not ok - ->can(...)
223 OUT
224 #   Failed test '->can(...)'
225 #   at $0 line 218.
226 #     can_ok() called with empty class or reference
227 ERR
228
229 #line 228
230 can_ok([], "foo");
231 out_ok( <<OUT, <<ERR );
232 not ok - ARRAY->can('foo')
233 OUT
234 #   Failed test 'ARRAY->can('foo')'
235 #   at $0 line 228.
236 #     ARRAY->can('foo') failed
237 ERR
238
239 #line 238
240 isa_ok(bless([], "Foo"), "Wibble");
241 out_ok( <<OUT, <<ERR );
242 not ok - The object isa Wibble
243 OUT
244 #   Failed test 'The object isa Wibble'
245 #   at $0 line 238.
246 #     The object isn't a 'Wibble' it's a 'Foo'
247 ERR
248
249 #line 248
250 isa_ok(42,    "Wibble", "My Wibble");
251 out_like( <<OUT, <<ERR );
252 not ok - My Wibble isa Wibble
253 OUT
254 #   Failed test 'My Wibble isa Wibble'
255 #   at $0 line 248.
256 #     My Wibble isn't a .*
257 ERR
258
259 #line 248
260 isa_ok(42,    "Wibble");
261 out_like( <<OUT, <<ERR );
262 not ok - The (thing|class) isa Wibble
263 OUT
264 #   Failed test 'The (thing|class) isa Wibble'
265 #   at $0 line 248.
266 #     The (thing|class) isn't a .*
267 ERR
268
269 #line 258
270 isa_ok(undef, "Wibble", "Another Wibble");
271 out_ok( <<OUT, <<ERR );
272 not ok - Another Wibble isa Wibble
273 OUT
274 #   Failed test 'Another Wibble isa Wibble'
275 #   at $0 line 258.
276 #     Another Wibble isn't defined
277 ERR
278
279 #line 268
280 isa_ok([],    "HASH");
281 out_ok( <<OUT, <<ERR );
282 not ok - The reference isa HASH
283 OUT
284 #   Failed test 'The reference isa HASH'
285 #   at $0 line 268.
286 #     The reference isn't a 'HASH' it's a 'ARRAY'
287 ERR
288
289 #line 278
290 new_ok(undef);
291 out_like( <<OUT, <<ERR );
292 not ok - new\\(\\) died
293 OUT
294 #   Failed test 'new\\(\\) died'
295 #   at $Filename line 278.
296 #     Error was:  Can't call method "new" on an undefined value at .*
297 ERR
298
299 #line 288
300 new_ok( "Does::Not::Exist" );
301 out_like( <<OUT, <<ERR );
302 not ok - new\\(\\) died
303 OUT
304 #   Failed test 'new\\(\\) died'
305 #   at $Filename line 288.
306 #     Error was:  Can't locate object method "new" via package "Does::Not::Exist" .*
307 ERR
308
309
310 { package Foo; sub new { } }
311 { package Bar; sub new { {} } }
312 { package Baz; sub new { bless {}, "Wibble" } }
313
314 #line 303
315 new_ok( "Foo" );
316 out_ok( <<OUT, <<ERR );
317 not ok - The object isa Foo
318 OUT
319 #   Failed test 'The object isa Foo'
320 #   at $0 line 303.
321 #     The object isn't defined
322 ERR
323
324 # line 313
325 new_ok( "Bar" );
326 out_ok( <<OUT, <<ERR );
327 not ok - The object isa Bar
328 OUT
329 #   Failed test 'The object isa Bar'
330 #   at $0 line 313.
331 #     The object isn't a 'Bar' it's a 'HASH'
332 ERR
333
334 #line 323
335 new_ok( "Baz" );
336 out_ok( <<OUT, <<ERR );
337 not ok - The object isa Baz
338 OUT
339 #   Failed test 'The object isa Baz'
340 #   at $0 line 323.
341 #     The object isn't a 'Baz' it's a 'Wibble'
342 ERR
343
344 #line 333
345 new_ok( "Baz", [], "no args" );
346 out_ok( <<OUT, <<ERR );
347 not ok - no args isa Baz
348 OUT
349 #   Failed test 'no args isa Baz'
350 #   at $0 line 333.
351 #     no args isn't a 'Baz' it's a 'Wibble'
352 ERR
353
354 #line 343
355 cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' );
356 out_ok( <<OUT, <<ERR );
357 not ok - cmp_ok eq
358 OUT
359 #   Failed test 'cmp_ok eq'
360 #   at $0 line 343.
361 #          got: 'foo'
362 #     expected: 'bar'
363 ERR
364
365 #line 354
366 cmp_ok( 42.1,  '==', 23,  , '       ==' );
367 out_ok( <<OUT, <<ERR );
368 not ok -        ==
369 OUT
370 #   Failed test '       =='
371 #   at $0 line 354.
372 #          got: 42.1
373 #     expected: 23
374 ERR
375
376 #line 365
377 cmp_ok( 42,    '!=', 42   , '       !=' );
378 out_ok( <<OUT, <<ERR );
379 not ok -        !=
380 OUT
381 #   Failed test '       !='
382 #   at $0 line 365.
383 #          got: 42
384 #     expected: anything else
385 ERR
386
387 #line 376
388 cmp_ok( 1,     '&&', 0    , '       &&' );
389 out_ok( <<OUT, <<ERR );
390 not ok -        &&
391 OUT
392 #   Failed test '       &&'
393 #   at $0 line 376.
394 #     '1'
395 #         &&
396 #     '0'
397 ERR
398
399 # line 388
400 cmp_ok( 42,    'eq', "foo", '       eq with numbers' );
401 out_ok( <<OUT, <<ERR );
402 not ok -        eq with numbers
403 OUT
404 #   Failed test '       eq with numbers'
405 #   at $0 line 388.
406 #          got: '42'
407 #     expected: 'foo'
408 ERR
409
410 {
411     my $warnings = '';
412     local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
413
414 # line 415
415     cmp_ok( 42,    '==', "foo", '       == with strings' );
416     out_ok( <<OUT, <<ERR );
417 not ok -        == with strings
418 OUT
419 #   Failed test '       == with strings'
420 #   at $0 line 415.
421 #          got: 42
422 #     expected: foo
423 ERR
424     My::Test::like(
425         $warnings,
426         qr/^Argument "foo" isn't numeric in .* at \(eval in cmp_ok\) $Filename line 415\.\n$/
427     );
428     $warnings = '';
429 }
430
431
432 {
433     my $warnings = '';
434     local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
435
436 #line 437
437     cmp_ok( undef, "ne", "", "undef ne empty string" );
438
439     $TB->is_eq( $out->read, <<OUT );
440 not ok - undef ne empty string
441 OUT
442
443     TODO: {
444         local $::TODO = 'cmp_ok() gives the wrong "expected" for undef';
445
446         $TB->is_eq( $err->read, <<ERR );
447 #   Failed test 'undef ne empty string'
448 #   at $0 line 437.
449 #          got: undef
450 #     expected: ''
451 ERR
452     }
453
454     My::Test::like(
455         $warnings,
456         qr/^Use of uninitialized value.* in string ne at \(eval in cmp_ok\) $Filename line 437.\n\z/
457     );
458 }
459
460
461 # generate a $!, it changes its value by context.
462 -e "wibblehibble";
463 my $Errno_Number = $!+0;
464 my $Errno_String = $!.'';
465 #line 425
466 cmp_ok( $!,    'eq', '',    '       eq with stringified errno' );
467 out_ok( <<OUT, <<ERR );
468 not ok -        eq with stringified errno
469 OUT
470 #   Failed test '       eq with stringified errno'
471 #   at $0 line 425.
472 #          got: '$Errno_String'
473 #     expected: ''
474 ERR
475
476 #line 436
477 cmp_ok( $!,    '==', -1,    '       eq with numerified errno' );
478 out_ok( <<OUT, <<ERR );
479 not ok -        eq with numerified errno
480 OUT
481 #   Failed test '       eq with numerified errno'
482 #   at $0 line 436.
483 #          got: $Errno_Number
484 #     expected: -1
485 ERR
486
487 #line 447
488 use_ok('Hooble::mooble::yooble');
489 my $more_err_re = <<ERR;
490 #   Failed test 'use Hooble::mooble::yooble;'
491 #   at $Filename line 447\\.
492 #     Tried to use 'Hooble::mooble::yooble'.
493 #     Error:  Can't locate Hooble.* in \\\@INC .*
494 ERR
495 out_like(
496     qr/^\Qnot ok - use Hooble::mooble::yooble;\E\n\z/,
497     qr/^$more_err_re/
498 );
499
500 #line 460
501 require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble');
502 $more_err_re = <<ERR;
503 #   Failed test 'require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;'
504 #   at $Filename line 460\\.
505 #     Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'.
506 #     Error:  Can't locate ALL.* in \\\@INC .*
507 ERR
508 out_like(
509     qr/^\Qnot ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;\E\n\z/,
510     qr/^$more_err_re/
511 );
512
513
514 END {
515     out_like( <<OUT, <<ERR );
516 OUT
517 # Looks like you failed $Total tests of $Total.
518 ERR
519
520     exit(0);
521 }