#!perl -w # HARNESS-NO-STREAM # HARNESS-NO-PRELOAD 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( <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( <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( <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( <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( <new\\(\\) died OUT # Failed test 'undef->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( <new\\(\\) died OUT # Failed test 'Does::Not::Exist->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( <is_eq( $out->read, <is_eq( $err->read, <