#!/usr/local/perl/5.8.8/bin/perl -w
use Test::More 'no_plan';
package Catch;
sub TIEHANDLE {
my($class, $var) = @_;
return bless { var => $var }, $class;
}
sub PRINT {
my($self) = shift;
${'main::'.$self->{var}} .= join '', @_;
}
sub OPEN {} # XXX Hackery in case the user redirects
sub CLOSE {} # XXX STDERR/STDOUT. This is not the behavior we want.
sub READ {}
sub READLINE {}
sub GETC {}
sub BINMODE {}
my $Original_File = 'lib/Carp/Assert.pm';
package main;
# pre-5.8.0's warns aren't caught by a tied STDERR.
$SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; };
tie *STDOUT, 'Catch', '_STDOUT_' or die $!;
tie *STDERR, 'Catch', '_STDERR_' or die $!;
{
undef $main::_STDOUT_;
undef $main::_STDERR_;
#line 115 lib/Carp/Assert.pm
BEGIN {
local %ENV = %ENV;
delete @ENV{qw(PERL_NDEBUG NDEBUG)};
require Carp::Assert;
Carp::Assert->import;
}
local %ENV = %ENV;
delete @ENV{qw(PERL_NDEBUG NDEBUG)};
undef $main::_STDOUT_;
undef $main::_STDERR_;
}
{
undef $main::_STDOUT_;
undef $main::_STDERR_;
#line 217 lib/Carp/Assert.pm
my $life = 'Whimper!';
ok( eval { assert( $life =~ /!$/ ); 1 }, 'life ends with a bang' );
undef $main::_STDOUT_;
undef $main::_STDERR_;
}
{
undef $main::_STDOUT_;
undef $main::_STDERR_;
#line 237 lib/Carp/Assert.pm
{
package Some::Other;
no Carp::Assert;
::ok( eval { assert(0) if DEBUG; 1 } );
}
undef $main::_STDOUT_;
undef $main::_STDERR_;
}
{
undef $main::_STDOUT_;
undef $main::_STDERR_;
#line 248 lib/Carp/Assert.pm
ok( eval { assert(1); 1 } );
ok( !eval { assert(0); 1 } );
undef $main::_STDOUT_;
undef $main::_STDERR_;
}
{
undef $main::_STDOUT_;
undef $main::_STDERR_;
#line 258 lib/Carp/Assert.pm
eval { assert(0) };
like( $@, '/^Assertion failed!/', 'error format' );
like( $@, '/Carp::Assert::assert\(0\) called at/', ' with stack trace' );
undef $main::_STDOUT_;
undef $main::_STDERR_;
}
{
undef $main::_STDOUT_;
undef $main::_STDERR_;
#line 273 lib/Carp/Assert.pm
eval { assert( Dogs->isa('People'), 'Dogs are people, too!' ); };
like( $@, '/^Assertion \(Dogs are people, too!\) failed!/', 'names' );
undef $main::_STDOUT_;
undef $main::_STDERR_;
}
{
undef $main::_STDOUT_;
undef $main::_STDERR_;
#line 310 lib/Carp/Assert.pm
my $foo = 1; my $bar = 2;
eval { affirm { $foo == $bar } };
like( $@, '/\$foo == \$bar/' );
undef $main::_STDOUT_;
undef $main::_STDERR_;
}
undef $main::_STDOUT_;
undef $main::_STDERR_;
eval q{
my $example = sub {
local $^W = 0;
#line 149 lib/Carp/Assert.pm
# Take the square root of a number.
sub my_sqrt {
my($num) = shift;
# the square root of a negative number is imaginary.
assert($num >= 0);
return sqrt $num;
}
;
}
};
is($@, '', "example from line 149");
{
undef $main::_STDOUT_;
undef $main::_STDERR_;
#line 149 lib/Carp/Assert.pm
# Take the square root of a number.
sub my_sqrt {
my($num) = shift;
# the square root of a negative number is imaginary.
assert($num >= 0);
return sqrt $num;
}
is( my_sqrt(4), 2, 'my_sqrt example with good input' );
ok( !eval{ my_sqrt(-1); 1 }, ' and pukes on bad' );
undef $main::_STDOUT_;
undef $main::_STDERR_;
}
undef $main::_STDOUT_;
undef $main::_STDERR_;
undef $main::_STDOUT_;
undef $main::_STDERR_;
eval q{
my $example = sub {
local $^W = 0;
#line 300 lib/Carp/Assert.pm
affirm {
my $customer = Customer->new($customerid);
my @cards = $customer->credit_cards;
grep { $_->is_active } @cards;
} "Our customer has an active credit card";
;
}
};
is($@, '', "example from line 300");
undef $main::_STDOUT_;
undef $main::_STDERR_;
syntax highlighted by Code2HTML, v. 0.9.1