Test::Exception extension with (evil?) overloading

adrianh has asked for the wisdom of the Perl Monks concerning the following question:

I often find myself doing things like this when testing exception-based code.

use Test::More 'no_plan';
use Test::Exception;
[download]

~~my $result = lives_ok {$o->answer} 'answer worked'; is $result, 42, 'answer returned 42';~~

Update:

my $result;
lives_ok {$result = $o->answer} 'answer worked';
is $result, 42, 'answer returned 42';
[download]

This is a bit clumsy since to me it is conceptually one test ($o->answer does not throw an exception and returns 42).

Of course, you can write a custom test subroutine lives_and_is, but you can very quickly end up writing lives_and_isnt, lives_and_is_deeply, etc.

Is there a more generic way?

I'm considering adding a live subroutine to Test::Exception that you can use like this:

is live{$o->answer}, 42, 'answer worked';
[download]

Implemented by, when an exception is thrown, returning an object that overloads all the comparison operations to return false.

Documentation:

live
       Returns the result of the given expression if no
       exception is thrown.

       If an exception is thrown an object is returned that
       evaluates to false when used in any standard boolean
       test or comparison operation ("<", "<=", ">", ">=",
       "==", "!=", "lt", "le", "gt", "ge", "eq" and "ne").

       This can be used to simplify testing for exceptions.
       For example:

           foreach my $n (3,2,1,0) {
               is live{$n/$n}, 1, "$n/$n == 1";
           };

       will produce

           ok 1 - 3/3 == 1
           ok 2 - 2/2 == 1
           ok 3 - 1/1 == 1
           not ok 4 - 0/0 == 1
           # Failed test (test.pl at line 37)
           #   got: 'DIED: Illegal division by zero at test.pl line 37
+.'
           # expected: '1'

       NOTE: that it is an object not a false value that is
       returned when an exception occurred.

           # this will pass even if foo dies
           ok(refaddr live {$o->foo}, 'foo returns object';

           # this will pass even if foo dies
           unlike live {$o->foo}, '/fribble/', 'no fribble';

       Appropriate care must be taken.
[download]

Implementation:

use Sub::Uplevel;

sub _exception_as_string {
    my $exception = shift;
    my $class = ref($exception);
    $exception = "$class ($exception)" 
            if $class && "$exception" !~ m/^\Q$class/;
    chomp($exception);
    return($exception);
};

{
    package Test::Exception::_NULL;
    use overload 
        q{""}   =>  sub { "${$_[0]}" },
        map { $_ => sub { return } } 
                ( qw( < <= > >= == != lt le gt ge eq ne bool ) ),
        fallback => 1;
    sub new { bless \$_[1], $_[0] };
};

sub live (&) {
    my $coderef = shift;
    my $value = eval { uplevel 2, $coderef };
    $value = Test::Exception::_NULL->new(
        "DIED: ". _exception_as_string($@)
    ) if $@;
    $value;
};
[download]

Sound sane? Or is Test::Exception::_NULL too evil to be allowed out in public?

Alternate suggestions?

Update per ER request - dvergin 2003-01-23

Comment on Test::Exception extension with (evil?) overloading Select or Download Code

Replies are listed 'Best First'.
Re: Test::Exception extension with (evil?) overloading by John M. Dlugosz (Monsignor) on Jan 18, 2003 at 02:06 UTC
I've only just started looking into Test::More and its kin, but the only other idea I have off hand is to pass a closure to a test function, to defer calling it until after the reusable code can throw an eval around it. That's what you mean by lives_and_is, right? Your complaint is that you have to duplicate all the tests to have a "lives" version. So, you want to wrap the sub-ref argument so that it can orthogonally apply to all the tests. Another way to have a modifier that applies orthogonally to all tests would be to pass the underlying test as well: `wrapper (\&innertest, \&subref, @args)` [download] This would evaluate subref in an eval, failing if it dies. Then, take the result and pass it, along with the remaining @args, to the innertest function, whose result is returned. So you could pass anything you want as the inner test. `wrapper (\&is, {$o->answer}, 42, 'answer returned 42');` [download] —John	[reply] [d/l] [select]
Re^2: Test::Exception extension with (evil?) overloading by adrianh (Chancellor) on Jan 18, 2003 at 18:51 UTC
Good option. Only downside is that you lose the prototyping of the test functions, and the calling syntax is a little more complex (in my opinion). You would also need to have it as: `wrapper (\&is, sub {$o->answer}, 42, 'answer returned 42')` [download] (we can only prototype the sub away if the coderef is the first argument) One other problem would be in figuring out the test name to output when an exception is thrown. Since it's optional for test subs it may, or may not, be the last argument.	[reply] [d/l]
Re^3: Test::Exception extension with (evil?) overloading by Aristotle (Chancellor) on Jan 18, 2003 at 20:40 UTC
In my other post I stopped just short of proposing `sub lives_and_tests_ok (&&;$) { my ($case, $test, $name) = @_; local $@; my $result = eval { $case->() }; $@ ? fail($name) : $test->($result, $name); }` [download] because it’s somewhat confusing to read the following: `lives_and_tests_ok ( sub { $o->answer }, sub { is shift, 42, shift }, "answer is 42" );` [download] I briefly pondered `sub lives_and_tests_ok (&&;$) { my ($case, $test, $name) = @_; local $@; local ($b, $a) = ($name, eval { $case->() }); $@ ? fail($name) : $test->($result, $name); }` [download] but I don’t think it’s any more readable than `lives_and_tests_ok ( sub { $o->answer }, sub { is $a, 42, $b }, "answer is 42" );` [download] Makeshifts last the longest.	[reply] [d/l] [select]
Re^4: Test::Exception extension with (evil?) overloading by adrianh (Chancellor) on Jan 18, 2003 at 21:50 UTC
Re^5: Test::Exception extension with (evil?) overloading by Aristotle (Chancellor) on Jan 18, 2003 at 22:11 UTC
Some notes below your chosen depth have not been shown here
Re: Test::Exception extension with (evil?) overloading by Aristotle (Chancellor) on Jan 18, 2003 at 16:41 UTC
`my $result = lives_ok {$o->answer} 'answer worked'; is $result, 42, 'answer returned 42';` [download] Depending on what semantics you intend, this simple case seems to be adequately covered by either: `is eval { $o->answer }, 42, 'answer returned 42';` or `is do { lives_ok {$o->answer} 'answer worked' }, 42, 'answer returned 42';` [download] The former treats the exception and `is` as a single test, the latter as two separate ones. I looked at your Test::Exception and don't see any other tests that make sense to combine with a Test::More test. So I'd say what you should do is document these memes in your POD rather than writing any code. Makeshifts last the longest.	[reply] [d/l] [select]
Re^2: Test::Exception extension with (evil?) overloading by adrianh (Chancellor) on Jan 18, 2003 at 17:45 UTC
`is eval { $o->answer }, 42, 'answer returned 42'` I've used this on occasion, but I've three issues with the idiom. First, when `undef` is a legal return value it's of no use. Second, you don't get to see the error message on failure. Third, you can't tell the difference between failure due to an exception and failure due to returning undef. `is do { lives_ok {$o->answer} 'answer worked' }, 42, 'answer returned 42';` [download] We're back to two tests - and it doesn't work :-) ... but only because I lied in my example... bad adrian... `lives_ok` returns a boolean, not the result of the coderef. This is usual for test subroutines so that you can use the `do_some_test(...) \|\| diag(some message)` idiom.	[reply] [d/l] [select]
Re^3: Test::Exception extension with (evil?) overloading by Aristotle (Chancellor) on Jan 18, 2003 at 17:52 UTC
Then what was the following code you posted supposed to do anyway? `my $result = lives_ok {$o->answer} 'answer worked'; is $result, 42, 'answer returned 42';` [download] Because the second snippet I posted behaves exactly like that. Makeshifts last the longest.	[reply] [d/l]
Re^4: Test::Exception extension with (evil?) overloading by adrianh (Chancellor) on Jan 18, 2003 at 17:55 UTC


P is for Practical
	PerlMonks