Re^6: Test::Exception extension with (evil?) overloading

[adrianh]

Ohhhh! Much better. With a tiny piece of magic we can get rid of that shift too.

sub lives_and (&$) {
    my ($test, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level+1;
    {
        my $ok = \&Test::Builder::ok;
        no warnings;
        local *Test::Builder::ok = sub {
            $_[2] = $name unless defined $_[2];
            $ok->(@_);
        };
        use warnings;
        eval { $test->() } and return 1;
    };
    if ($@) {
        fail($name);
        diag("Died: $@");
    };
    return;
}

Which allows us to do:

lives_and { is 42, 42 } 'answer is 42';
lives_and { is 24, 42 } 'answer is 42';
lives_and { is sub { die 'oops' }->(), 42 } 'answer is 42';

giving us

ok 1 - answer is 42                                                   
+          
not ok 2 - answer is 42                                               
+          
#     Failed test (foo.pl at line 29)                                 
+          
#          got: '24'                                                  
+          
#     expected: '42'                                                  
+          
not ok 3 - answer is 42                                               
+          
#     Failed test (foo.pl at line 31)                                 
+          
# Died: oops at foo.pl line 31.