#   Failed test ' -- the inner trap -- print() with closed STDOUT: Warnings'
#   at t/03-files.pl line 80.
#                   'print() on closed filehandle STDOUT at t/03-files.pl line 131.
# 
# '
#     doesn't match '(?-xism:\A(?-xism:^print\(\)\ on\ closed\ filehandle\ STDOUT\ at\ )[^\0]*\z)'
# Looks like you failed 1 test of 76.

##</code><code>##

sidhekin@blackbox[07:05:22]~$ 562perl -MTest::More=tests,1 -le 'like("print() on closed filehandle STDOUT at t/03-files.pl line 131.\n", qr/(?-xism:\A(?-xism:^print\(\)\ on\ closed\ filehandle\ STDOUT\ at\ )[^\0]*\z)/)'
1..1
ok 1
sidhekin@blackbox[19:38:28]~$ 

##</code><code>##

tr.pmnote-641932 td.reply-body:first-child:before {
  content: url(http://icanhascheezburger.wordpress.com/files/2007/10/128347333970156250nooneunderstan.jpg);
}
tr.pmnote-641932 td.reply-body * {
  display: none !important;
}

##</code><code>##

sub get_definition_result {
       my ($dbh, $word_term, $dict) = @_; 
 
       my $result;
       my $definition_sth = $dbh->prepare(qq{SELECT definition from dream_terms where term=?});
       $definition_sth->execute($word_term);
       $definition_sth->bind_col(1, \$result);

# XXX: don't you need to fetch here?
 
       print ">>>$result<<<\n";  
 
       return [ [ undef, $result ] ];
}

##</code><code>##

use Test::More qw( no_plan );
use Test::Trap qw(:void_is_scalar:diag_all_on_fail);

# thanks to :void_is_scalar, foo is called in
# scalar context here:
trap { foo("bar") };

# foo is still called in list context here:
() = trap { foo("baz") };

# trap a little ...
trap { 1 };

$trap->return_is_deeply( [1], 'Trapped [1]' );
# prints "ok 1\n"

$trap->return_is_deeply( [2], 'Trapped [2]' );
# prints "not ok 2\n" with diagnosis:
#   Failed test 'Trapped [2]'
#   at .../trap.pl line 17.
#     Structures begin differing at:
#          $got->[0] = '1'
#     $expected->[0] = '2'
# Trap contains:
#     bless({
#       leaveby     => "return",
#       "return"    => [1],
#       stderr      => "",
#       stdout      => "",
#       "wantarray" => "",
#       "warn"      => [],
#     }, "Test::Trap")

##</code><code>##

# bart's setup:
$re = 'Il est (\d+) heurs moins (\d+).';
$translation = 'It\'s $2 to $1.';
$_ = 'Il est 14 heurs moins 28.';

# my code:
$translator{$re} ||= do {
  (my $t = $translation) =~ s/([\\"])/\\$1/g;
  eval qq(sub { "$t" });
};
s/$re/$translator{$re}()/e;

# and a print:
print

##</code><code>##

#!/usr/bin/perl

use Test::More tests => 6;
use Test::Exception;
use Test::Trap;

sub A1::DESTROY { eval {} }
sub A2::DESTROY { die 42 }
sub A3::DESTROY { diag "XXX"; die }

diag "Should die, but doesn't:";
{ my $obj = bless [], 'A3'; 1 }; # doesn't die!

diag "Test::Exception:";
dies_ok { my $obj = bless [], 'A1'; die } q[Exceptions aren't hidden by eval{} during scope cleanup];
throws_ok { my $obj = bless [], 'A2'; die 43 } qr/43/, q[Of multiple failures, the "primary" one is returned];
dies_ok { my $obj = bless [], 'A3'; return 1 } q[Failure during scope cleanup is detected];

diag "Test::Trap:";

trap { my $obj = bless [], 'A1'; die };
$trap->did_die( q[Exceptions aren't hidden by eval{} during scope cleanup] );

trap { my $obj = bless [], 'A2'; die 43 };
$trap->die_like( qr/43/, q[Of multiple failures, the "primary" one is returned] );

trap { my $obj = bless [], 'A3'; 1 };
$trap->did_die( q[Failure during scope cleanup is detected] );

##</code><code>##

1..6
# Should die, but doesn't:
# XXX
# Test::Exception:
not ok 1 - Exceptions aren't hidden by eval{} during scope cleanup
#   Failed test 'Exceptions aren't hidden by eval{} during scope cleanup'
#   at /home/eirik/tmp/kladd.pl line 15.
ok 2 - Of multiple failures, the "primary" one is returned
# XXX
not ok 3 - Failure during scope cleanup is detected
#   Failed test 'Failure during scope cleanup is detected'
#   at /home/eirik/tmp/kladd.pl line 17.
# Test::Trap:
ok 4 - Exceptions aren't hidden by eval{} during scope cleanup
ok 5 - Of multiple failures, the "primary" one is returned
# XXX
not ok 6 - Failure during scope cleanup is detected
#   Failed test 'Failure during scope cleanup is detected'
#   at /home/eirik/tmp/kladd.pl line 28.
#     Expecting to die(), but instead return()ed with []
# Looks like you failed 3 tests of 6.

##</code><code>##

#!/usr/bin/perl

sub test { 1 }
sub versive() { 2 }

my $x = "test';
$x =~ s/^t*|t+$/g;
my $y = test ? 'true' : 'false';
$y =~ s{e]{E};
print $y if versive *$

__END__
;@{BEGIN { print 'gotcha!' }}
__END__
?;
__END__
";
__END__
/*%*;
__END__
}*%*;

##</code><code>##

perl -wles/ -e+/chr -e32/ge,print -efor@_=q.Look, -eMa -e-- -eno -eshell -emeta -echaracters..chr -e33

##</code><code>##

# like this?
register( foo => [qw( i p n )], \&bar );

# or more terse?
register( 'foo(i,p,n)', \&bar );

# or more verbose?
register( foo => [qw( indexed predicate name )], \&bar );