4 if( $ENV{PERL_CORE} ) {
6 @INC = ('../lib', 'lib');
15 require Test::Simple::Catch;
16 my($out, $err) = Test::Simple::Catch::caught();
17 local $ENV{HARNESS_ACTIVE} = 0;
20 # Can't use Test.pm, that's a 5.005 thing.
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);
37 sub main::out_ok ($$) {
38 $TB->is_eq( $out->read, shift );
39 $TB->is_eq( $err->read, shift );
42 sub main::out_like ($$) {
43 my($output, $failure) = @_;
45 $TB->like( $out->read, qr/$output/ );
46 $TB->like( $err->read, qr/$failure/ );
55 Test::More->import(tests => $Total);
56 $out->read; # clear the plan from $out
58 # This should all work in the presence of a __DIE__ handler.
59 local $SIG{__DIE__} = sub { $TB->ok(0, "DIE handler called: ".join "", @_); };
62 my $tb = Test::More->builder;
65 my $Filename = quotemeta $0;
70 out_ok( <<OUT, <<ERR );
73 # Failed test 'failing'
79 is( "foo", "bar", 'foo is bar?');
80 out_ok( <<OUT, <<ERR );
83 # Failed test 'foo is bar?'
90 is( undef, '', 'undef is empty string?');
91 out_ok( <<OUT, <<ERR );
92 not ok - undef is empty string?
94 # Failed test 'undef is empty string?'
101 is( undef, 0, 'undef is 0?');
102 out_ok( <<OUT, <<ERR );
105 # Failed test 'undef is 0?'
112 is( '', 0, 'empty string is 0?' );
113 out_ok( <<OUT, <<ERR );
114 not ok - empty string is 0?
116 # Failed test 'empty string is 0?'
123 isnt("foo", "foo", 'foo isnt foo?' );
124 out_ok( <<OUT, <<ERR );
125 not ok - foo isnt foo?
127 # Failed test 'foo isnt foo?'
130 # expected: anything else
134 isn't("foo", "foo",'foo isn\'t foo?' );
135 out_ok( <<OUT, <<ERR );
136 not ok - foo isn't foo?
138 # Failed test 'foo isn\'t foo?'
141 # expected: anything else
145 isnt(undef, undef, 'undef isnt undef?');
146 out_ok( <<OUT, <<ERR );
147 not ok - undef isnt undef?
149 # Failed test 'undef isnt undef?'
152 # expected: anything else
156 like( "foo", '/that/', 'is foo like that' );
157 out_ok( <<OUT, <<ERR );
158 not ok - is foo like that
160 # Failed test 'is foo like that'
163 # doesn't match '/that/'
167 unlike( "foo", '/foo/', 'is foo unlike foo' );
168 out_ok( <<OUT, <<ERR );
169 not ok - is foo unlike foo
171 # Failed test 'is foo unlike foo'
177 # Nick Clark found this was a bug. Fixed in 0.40.
179 like( "bug", '/(%)/', 'regex with % in it' );
180 out_ok( <<OUT, <<ERR );
181 not ok - regex with % in it
183 # Failed test 'regex with % in it'
186 # doesn't match '/(%)/'
191 out_ok( <<OUT, <<ERR );
194 # Failed test 'fail()'
199 can_ok('Mooble::Hooble::Yooble', qw(this that));
200 out_ok( <<OUT, <<ERR );
201 not ok - Mooble::Hooble::Yooble->can(...)
203 # Failed test 'Mooble::Hooble::Yooble->can(...)'
205 # Mooble::Hooble::Yooble->can('this') failed
206 # Mooble::Hooble::Yooble->can('that') failed
210 can_ok('Mooble::Hooble::Yooble', ());
211 out_ok( <<OUT, <<ERR );
212 not ok - Mooble::Hooble::Yooble->can(...)
214 # Failed test 'Mooble::Hooble::Yooble->can(...)'
216 # can_ok() called with no methods
220 can_ok(undef, undef);
221 out_ok( <<OUT, <<ERR );
224 # Failed test '->can(...)'
226 # can_ok() called with empty class or reference
231 out_ok( <<OUT, <<ERR );
232 not ok - ARRAY->can('foo')
234 # Failed test 'ARRAY->can('foo')'
236 # ARRAY->can('foo') failed
240 isa_ok(bless([], "Foo"), "Wibble");
241 out_ok( <<OUT, <<ERR );
242 not ok - The object isa Wibble
244 # Failed test 'The object isa Wibble'
246 # The object isn't a 'Wibble' it's a 'Foo'
250 isa_ok(42, "Wibble", "My Wibble");
251 out_ok( <<OUT, <<ERR );
252 not ok - My Wibble isa Wibble
254 # Failed test 'My Wibble isa Wibble'
256 # My Wibble isn't a class or reference
260 isa_ok(42, "Wibble");
261 out_ok( <<OUT, <<ERR );
262 not ok - The thing isa Wibble
264 # Failed test 'The thing isa Wibble'
266 # The thing isn't a class or reference
270 isa_ok(undef, "Wibble", "Another Wibble");
271 out_ok( <<OUT, <<ERR );
272 not ok - Another Wibble isa Wibble
274 # Failed test 'Another Wibble isa Wibble'
276 # Another Wibble isn't defined
281 out_ok( <<OUT, <<ERR );
282 not ok - The reference isa HASH
284 # Failed test 'The reference isa HASH'
286 # The reference isn't a 'HASH' it's a 'ARRAY'
291 out_like( <<OUT, <<ERR );
292 not ok - new\\(\\) died
294 # Failed test 'new\\(\\) died'
295 # at $Filename line 278.
296 # Error was: Can't call method "new" on an undefined value at .*
300 new_ok( "Does::Not::Exist" );
301 out_like( <<OUT, <<ERR );
302 not ok - new\\(\\) died
304 # Failed test 'new\\(\\) died'
305 # at $Filename line 288.
306 # Error was: Can't locate object method "new" via package "Does::Not::Exist" .*
310 { package Foo; sub new { } }
311 { package Bar; sub new { {} } }
312 { package Baz; sub new { bless {}, "Wibble" } }
316 out_ok( <<OUT, <<ERR );
317 not ok - The object isa Foo
319 # Failed test 'The object isa Foo'
321 # The object isn't defined
326 out_ok( <<OUT, <<ERR );
327 not ok - The object isa Bar
329 # Failed test 'The object isa Bar'
331 # The object isn't a 'Bar' it's a 'HASH'
336 out_ok( <<OUT, <<ERR );
337 not ok - The object isa Baz
339 # Failed test 'The object isa Baz'
341 # The object isn't a 'Baz' it's a 'Wibble'
345 new_ok( "Baz", [], "no args" );
346 out_ok( <<OUT, <<ERR );
347 not ok - no args isa Baz
349 # Failed test 'no args isa Baz'
351 # no args isn't a 'Baz' it's a 'Wibble'
355 cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' );
356 out_ok( <<OUT, <<ERR );
359 # Failed test 'cmp_ok eq'
366 cmp_ok( 42.1, '==', 23, , ' ==' );
367 out_ok( <<OUT, <<ERR );
377 cmp_ok( 42, '!=', 42 , ' !=' );
378 out_ok( <<OUT, <<ERR );
384 # expected: anything else
388 cmp_ok( 1, '&&', 0 , ' &&' );
389 out_ok( <<OUT, <<ERR );
400 cmp_ok( 42, 'eq', "foo", ' eq with numbers' );
401 out_ok( <<OUT, <<ERR );
402 not ok - eq with numbers
404 # Failed test ' eq with numbers'
412 local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
415 cmp_ok( 42, '==', "foo", ' == with strings' );
416 out_ok( <<OUT, <<ERR );
417 not ok - == with strings
419 # Failed test ' == with strings'
426 qr/^Argument "foo" isn't numeric in .* at cmp_ok \[from $Filename line 404\] line 1\.\n$/
434 local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
437 cmp_ok( undef, "ne", "", "undef ne empty string" );
439 $TB->is_eq( $out->read, <<OUT );
440 not ok - undef ne empty string
444 local $::TODO = 'cmp_ok() gives the wrong "expected" for undef';
446 $TB->is_eq( $err->read, <<ERR );
447 # Failed test 'undef ne empty string'
456 qr/^Use of uninitialized value.* in string ne at cmp_ok \[from $Filename line 426\] line 1\.\n\z/
461 # generate a $!, it changes its value by context.
463 my $Errno_Number = $!+0;
464 my $Errno_String = $!.'';
466 cmp_ok( $!, 'eq', '', ' eq with stringified errno' );
467 out_ok( <<OUT, <<ERR );
468 not ok - eq with stringified errno
470 # Failed test ' eq with stringified errno'
472 # got: '$Errno_String'
477 cmp_ok( $!, '==', -1, ' eq with numerified errno' );
478 out_ok( <<OUT, <<ERR );
479 not ok - eq with numerified errno
481 # Failed test ' eq with numerified errno'
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 .*
496 qr/^\Qnot ok - use Hooble::mooble::yooble;\E\n\z/,
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 .*
509 qr/^\Qnot ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;\E\n\z/,
515 out_like( <<OUT, <<ERR );
517 # Looks like you failed $Total tests of $Total.