| #!perl -w |
| |
| BEGIN { |
| if( $ENV{PERL_CORE} ) { |
| chdir 't'; |
| @INC = ('../lib', 'lib'); |
| } |
| else { |
| unshift @INC, 't/lib'; |
| } |
| } |
| |
| use strict; |
| |
| require Test::Simple::Catch; |
| my($out, $err) = Test::Simple::Catch::caught(); |
| local $ENV{HARNESS_ACTIVE} = 0; |
| |
| |
| # Can't use Test.pm, that's a 5.005 thing. |
| package My::Test; |
| |
| # This has to be a require or else the END block below runs before |
| # Test::Builder's own and the ending diagnostics don't come out right. |
| require Test::Builder; |
| my $TB = Test::Builder->create; |
| $TB->plan(tests => 80); |
| |
| sub like ($$;$) { |
| $TB->like(@_); |
| } |
| |
| sub is ($$;$) { |
| $TB->is_eq(@_); |
| } |
| |
| sub main::out_ok ($$) { |
| $TB->is_eq( $out->read, shift ); |
| $TB->is_eq( $err->read, shift ); |
| } |
| |
| sub main::out_like ($$) { |
| my($output, $failure) = @_; |
| |
| $TB->like( $out->read, qr/$output/ ); |
| $TB->like( $err->read, qr/$failure/ ); |
| } |
| |
| |
| package main; |
| |
| require Test::More; |
| our $TODO; |
| my $Total = 38; |
| Test::More->import(tests => $Total); |
| $out->read; # clear the plan from $out |
| |
| # This should all work in the presence of a __DIE__ handler. |
| local $SIG{__DIE__} = sub { $TB->ok(0, "DIE handler called: ".join "", @_); }; |
| |
| |
| my $tb = Test::More->builder; |
| $tb->use_numbers(0); |
| |
| my $Filename = quotemeta $0; |
| |
| |
| #line 38 |
| ok( 0, 'failing' ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - failing |
| OUT |
| # Failed test 'failing' |
| # at $0 line 38. |
| ERR |
| |
| |
| #line 40 |
| is( "foo", "bar", 'foo is bar?'); |
| out_ok( <<OUT, <<ERR ); |
| not ok - foo is bar? |
| OUT |
| # Failed test 'foo is bar?' |
| # at $0 line 40. |
| # got: 'foo' |
| # expected: 'bar' |
| ERR |
| |
| #line 89 |
| is( undef, '', 'undef is empty string?'); |
| out_ok( <<OUT, <<ERR ); |
| not ok - undef is empty string? |
| OUT |
| # Failed test 'undef is empty string?' |
| # at $0 line 89. |
| # got: undef |
| # expected: '' |
| ERR |
| |
| #line 99 |
| is( undef, 0, 'undef is 0?'); |
| out_ok( <<OUT, <<ERR ); |
| not ok - undef is 0? |
| OUT |
| # Failed test 'undef is 0?' |
| # at $0 line 99. |
| # got: undef |
| # expected: '0' |
| ERR |
| |
| #line 110 |
| is( '', 0, 'empty string is 0?' ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - empty string is 0? |
| OUT |
| # Failed test 'empty string is 0?' |
| # at $0 line 110. |
| # got: '' |
| # expected: '0' |
| ERR |
| |
| #line 121 |
| isnt("foo", "foo", 'foo isnt foo?' ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - foo isnt foo? |
| OUT |
| # Failed test 'foo isnt foo?' |
| # at $0 line 121. |
| # got: 'foo' |
| # expected: anything else |
| ERR |
| |
| #line 132 |
| isn't("foo", "foo",'foo isn\'t foo?' ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - foo isn't foo? |
| OUT |
| # Failed test 'foo isn\'t foo?' |
| # at $0 line 132. |
| # got: 'foo' |
| # expected: anything else |
| ERR |
| |
| #line 143 |
| isnt(undef, undef, 'undef isnt undef?'); |
| out_ok( <<OUT, <<ERR ); |
| not ok - undef isnt undef? |
| OUT |
| # Failed test 'undef isnt undef?' |
| # at $0 line 143. |
| # got: undef |
| # expected: anything else |
| ERR |
| |
| #line 154 |
| like( "foo", '/that/', 'is foo like that' ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - is foo like that |
| OUT |
| # Failed test 'is foo like that' |
| # at $0 line 154. |
| # 'foo' |
| # doesn't match '/that/' |
| ERR |
| |
| #line 165 |
| unlike( "foo", '/foo/', 'is foo unlike foo' ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - is foo unlike foo |
| OUT |
| # Failed test 'is foo unlike foo' |
| # at $0 line 165. |
| # 'foo' |
| # matches '/foo/' |
| ERR |
| |
| # Nick Clark found this was a bug. Fixed in 0.40. |
| # line 177 |
| like( "bug", '/(%)/', 'regex with % in it' ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - regex with % in it |
| OUT |
| # Failed test 'regex with % in it' |
| # at $0 line 177. |
| # 'bug' |
| # doesn't match '/(%)/' |
| ERR |
| |
| #line 188 |
| fail('fail()'); |
| out_ok( <<OUT, <<ERR ); |
| not ok - fail() |
| OUT |
| # Failed test 'fail()' |
| # at $0 line 188. |
| ERR |
| |
| #line 197 |
| can_ok('Mooble::Hooble::Yooble', qw(this that)); |
| out_ok( <<OUT, <<ERR ); |
| not ok - Mooble::Hooble::Yooble->can(...) |
| OUT |
| # Failed test 'Mooble::Hooble::Yooble->can(...)' |
| # at $0 line 197. |
| # Mooble::Hooble::Yooble->can('this') failed |
| # Mooble::Hooble::Yooble->can('that') failed |
| ERR |
| |
| #line 208 |
| can_ok('Mooble::Hooble::Yooble', ()); |
| out_ok( <<OUT, <<ERR ); |
| not ok - Mooble::Hooble::Yooble->can(...) |
| OUT |
| # Failed test 'Mooble::Hooble::Yooble->can(...)' |
| # at $0 line 208. |
| # can_ok() called with no methods |
| ERR |
| |
| #line 218 |
| can_ok(undef, undef); |
| out_ok( <<OUT, <<ERR ); |
| not ok - ->can(...) |
| OUT |
| # Failed test '->can(...)' |
| # at $0 line 218. |
| # can_ok() called with empty class or reference |
| ERR |
| |
| #line 228 |
| can_ok([], "foo"); |
| out_ok( <<OUT, <<ERR ); |
| not ok - ARRAY->can('foo') |
| OUT |
| # Failed test 'ARRAY->can('foo')' |
| # at $0 line 228. |
| # ARRAY->can('foo') failed |
| ERR |
| |
| #line 238 |
| isa_ok(bless([], "Foo"), "Wibble"); |
| out_ok( <<OUT, <<ERR ); |
| not ok - The object isa Wibble |
| OUT |
| # Failed test 'The object isa Wibble' |
| # at $0 line 238. |
| # The object isn't a 'Wibble' it's a 'Foo' |
| ERR |
| |
| #line 248 |
| isa_ok(42, "Wibble", "My Wibble"); |
| out_ok( <<OUT, <<ERR ); |
| not ok - My Wibble isa Wibble |
| OUT |
| # Failed test 'My Wibble isa Wibble' |
| # at $0 line 248. |
| # My Wibble isn't a class or reference |
| ERR |
| |
| #line 248 |
| isa_ok(42, "Wibble"); |
| out_ok( <<OUT, <<ERR ); |
| not ok - The thing isa Wibble |
| OUT |
| # Failed test 'The thing isa Wibble' |
| # at $0 line 248. |
| # The thing isn't a class or reference |
| ERR |
| |
| #line 258 |
| isa_ok(undef, "Wibble", "Another Wibble"); |
| out_ok( <<OUT, <<ERR ); |
| not ok - Another Wibble isa Wibble |
| OUT |
| # Failed test 'Another Wibble isa Wibble' |
| # at $0 line 258. |
| # Another Wibble isn't defined |
| ERR |
| |
| #line 268 |
| isa_ok([], "HASH"); |
| out_ok( <<OUT, <<ERR ); |
| not ok - The reference isa HASH |
| OUT |
| # Failed test 'The reference isa HASH' |
| # at $0 line 268. |
| # The reference isn't a 'HASH' it's a 'ARRAY' |
| ERR |
| |
| #line 278 |
| new_ok(undef); |
| out_like( <<OUT, <<ERR ); |
| not ok - new\\(\\) died |
| OUT |
| # Failed test 'new\\(\\) died' |
| # at $Filename line 278. |
| # Error was: Can't call method "new" on an undefined value at .* |
| ERR |
| |
| #line 288 |
| new_ok( "Does::Not::Exist" ); |
| out_like( <<OUT, <<ERR ); |
| not ok - new\\(\\) died |
| OUT |
| # Failed test 'new\\(\\) died' |
| # at $Filename line 288. |
| # Error was: Can't locate object method "new" via package "Does::Not::Exist" .* |
| ERR |
| |
| |
| { package Foo; sub new { } } |
| { package Bar; sub new { {} } } |
| { package Baz; sub new { bless {}, "Wibble" } } |
| |
| #line 303 |
| new_ok( "Foo" ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - The object isa Foo |
| OUT |
| # Failed test 'The object isa Foo' |
| # at $0 line 303. |
| # The object isn't defined |
| ERR |
| |
| # line 313 |
| new_ok( "Bar" ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - The object isa Bar |
| OUT |
| # Failed test 'The object isa Bar' |
| # at $0 line 313. |
| # The object isn't a 'Bar' it's a 'HASH' |
| ERR |
| |
| #line 323 |
| new_ok( "Baz" ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - The object isa Baz |
| OUT |
| # Failed test 'The object isa Baz' |
| # at $0 line 323. |
| # The object isn't a 'Baz' it's a 'Wibble' |
| ERR |
| |
| #line 333 |
| new_ok( "Baz", [], "no args" ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - no args isa Baz |
| OUT |
| # Failed test 'no args isa Baz' |
| # at $0 line 333. |
| # no args isn't a 'Baz' it's a 'Wibble' |
| ERR |
| |
| #line 343 |
| cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - cmp_ok eq |
| OUT |
| # Failed test 'cmp_ok eq' |
| # at $0 line 343. |
| # got: 'foo' |
| # expected: 'bar' |
| ERR |
| |
| #line 354 |
| cmp_ok( 42.1, '==', 23, , ' ==' ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - == |
| OUT |
| # Failed test ' ==' |
| # at $0 line 354. |
| # got: 42.1 |
| # expected: 23 |
| ERR |
| |
| #line 365 |
| cmp_ok( 42, '!=', 42 , ' !=' ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - != |
| OUT |
| # Failed test ' !=' |
| # at $0 line 365. |
| # got: 42 |
| # expected: anything else |
| ERR |
| |
| #line 376 |
| cmp_ok( 1, '&&', 0 , ' &&' ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - && |
| OUT |
| # Failed test ' &&' |
| # at $0 line 376. |
| # '1' |
| # && |
| # '0' |
| ERR |
| |
| # line 388 |
| cmp_ok( 42, 'eq', "foo", ' eq with numbers' ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - eq with numbers |
| OUT |
| # Failed test ' eq with numbers' |
| # at $0 line 388. |
| # got: '42' |
| # expected: 'foo' |
| ERR |
| |
| { |
| my $warnings = ''; |
| local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; |
| |
| # line 415 |
| cmp_ok( 42, '==', "foo", ' == with strings' ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - == with strings |
| OUT |
| # Failed test ' == with strings' |
| # at $0 line 415. |
| # got: 42 |
| # expected: foo |
| ERR |
| My::Test::like( |
| $warnings, |
| qr/^Argument "foo" isn't numeric in .* at \(eval in cmp_ok\) $Filename line 415\.\n$/ |
| ); |
| $warnings = ''; |
| } |
| |
| |
| { |
| my $warnings = ''; |
| local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; |
| |
| #line 437 |
| cmp_ok( undef, "ne", "", "undef ne empty string" ); |
| |
| $TB->is_eq( $out->read, <<OUT ); |
| not ok - undef ne empty string |
| OUT |
| |
| TODO: { |
| local $::TODO = 'cmp_ok() gives the wrong "expected" for undef'; |
| |
| $TB->is_eq( $err->read, <<ERR ); |
| # Failed test 'undef ne empty string' |
| # at $0 line 437. |
| # got: undef |
| # expected: '' |
| ERR |
| } |
| |
| My::Test::like( |
| $warnings, |
| qr/^Use of uninitialized value.* in string ne at \(eval in cmp_ok\) $Filename line 437.\n\z/ |
| ); |
| } |
| |
| |
| # generate a $!, it changes its value by context. |
| -e "wibblehibble"; |
| my $Errno_Number = $!+0; |
| my $Errno_String = $!.''; |
| #line 425 |
| cmp_ok( $!, 'eq', '', ' eq with stringified errno' ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - eq with stringified errno |
| OUT |
| # Failed test ' eq with stringified errno' |
| # at $0 line 425. |
| # got: '$Errno_String' |
| # expected: '' |
| ERR |
| |
| #line 436 |
| cmp_ok( $!, '==', -1, ' eq with numerified errno' ); |
| out_ok( <<OUT, <<ERR ); |
| not ok - eq with numerified errno |
| OUT |
| # Failed test ' eq with numerified errno' |
| # at $0 line 436. |
| # got: $Errno_Number |
| # expected: -1 |
| ERR |
| |
| #line 447 |
| use_ok('Hooble::mooble::yooble'); |
| my $more_err_re = <<ERR; |
| # Failed test 'use Hooble::mooble::yooble;' |
| # at $Filename line 447\\. |
| # Tried to use 'Hooble::mooble::yooble'. |
| # Error: Can't locate Hooble.* in \\\@INC .* |
| ERR |
| out_like( |
| qr/^\Qnot ok - use Hooble::mooble::yooble;\E\n\z/, |
| qr/^$more_err_re/ |
| ); |
| |
| #line 460 |
| require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'); |
| $more_err_re = <<ERR; |
| # Failed test 'require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;' |
| # at $Filename line 460\\. |
| # Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'. |
| # Error: Can't locate ALL.* in \\\@INC .* |
| ERR |
| out_like( |
| qr/^\Qnot ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;\E\n\z/, |
| qr/^$more_err_re/ |
| ); |
| |
| |
| END { |
| out_like( <<OUT, <<ERR ); |
| OUT |
| # Looks like you failed $Total tests of $Total. |
| ERR |
| |
| exit(0); |
| } |