How many different ways can Perl code fail?

[Jeffrey Kegler]

How many different ways can Perl code fail in a string eval? By "different" here I mean different enough to require a separate regression test to ensure that all the error codes and messages are captured when the eval'd code fails in that way. Warnings count as failures for this purpose. My current census of potential sources of information about the failure of a string eval are

1. The eval's return value.
2. The $EVAL_ERROR variable.
3. Warning messages trappable using $SIG{__WARN__}.

I want to know this because I'm writing regression tests of the error messages which Parse::Marpa returns to users who supply Perl code to be eval'd inside the module. The application is a parser generator, and the user code is used (for example) for the semantics of rules in the grammar for which Parse::Marpa generates the parser. The code to be eval'd is not known as of the compile phase, so string eval's are necessary. I have these five cases:

1. Compile phase warnings. For example:

   # this should be a compile phase warning
   my $x = 0;
   my $x = 1;
   my $x = 2;
   

2. Compile phase fatal errors. For example:

   # this should be a compile phase error
   my $x = 0;
   $x=;
   

3. Run phase warnings. Here I'm just using the warn builtin:

   # this should be a run phase warning
   warn "Test Warning 1";
   

4. Run phase fatal error. I use a division by zero to create this.

   # this should be a run phase error
   my $x = 0;
   $x = 711/0;
   

5. An explicit run phase call to die().

Note I treat an explicit call to die() as different from a non-explicit fatal error in the run phase. I'm not sure this is necessary. I don't treat a warning created explicitly with a call to warn() as a special case. And I don't handle calls to die() in the compile phase (which can happen in a BEGIN block) as a special case. Senior monks may be able to advise here.

There's a cost to identifying special cases, because there are 8 places in Parse::Marpa where user code is called, so every special case of Perl code failure needs eight tests. My test module is already long, as you can see below. The goal here is to identify as many cases as necessary, but no more. :-)

thanks!

#!perl
# Ensure various coding errors are caught

use 5.010_000;
use strict;
use warnings;

use Test::More tests => 42;

use lib 'lib';
use lib 't/lib';
use Marpa::Test;
use Carp;
use English qw( -no_match_vars );

BEGIN {
    use_ok( 'Parse::Marpa' );
}

my @features = qw(
    preamble lex_preamble
    e_op_action default_action
    lexer
    null_action
    unstringify_grammar
    unstringify_recce
);

my @tests = (
    'compile phase warning',
    'compile phase fatal',
    'run phase warning',
    'run phase error',
    'run phase die',
);

my %good_code = (
    'e op action' => 'my $error =',
    'e number action' => 'my $error =',
    'default action' => 'my $error =',
);

my %test_code;
my %expected;
for my $test (@tests) {
    $test_code{$test} = '1;';
    for my $feature (@features) {
        $expected{$test}{$feature} = q{};
    }
}

my $getting_headers = 1;
my @headers;
my $data = q{};

LINE: while (my $line = <DATA>)
{

    if ($getting_headers)
    {
        next LINE if $line =~ m/ \A \s* \Z/xms;
        if ($line =~ s/ \A [|] \s+ //xms)
        {
            chomp $line;
            push(@headers, $line);
            next LINE;
        } else {
            $getting_headers = 0;
            $data = q{};
        }
    }
    
    # getting data

    if ($line =~ /\A__END__\Z/xms) {
        HEADER: while (my $header = pop @headers) {
            if ($header =~ s/\A expected \s //xms) {
                my ($feature, $test) = ($header =~ m/\A ([^\s]*) \s+ (
+.*) \Z/xms);
                croak("expected result given for unknown test, feature
+: $test, $feature")
                    unless defined $expected{$test}{$feature};
                $expected{$test}{$feature} = $data;
                next HEADER;
            }
            if ($header =~ s/\A good \s code \s //xms) {
                chomp $header;
                $good_code{$header} = $data;
                next HEADER;
            }
            if ($header =~ s/\A bad \s code \s //xms) {
                chomp $header;
                croak("test code given for unknown test: $header")
                    unless defined $test_code{$header};
                $test_code{$header} = $data;
                next HEADER;
            }
            croak("Bad header: $header");
        } # HEADER
        $getting_headers = 1;
        $data = q{};
    } # if $line

    $data .= $line;
}

sub canonical {
    my $template = shift;
    my $where = shift;
    my $long_where = shift;
    $long_where //= $where;
    $template =~ s/ \b package \s Parse [:][:] Marpa [:][:] [EP] _ [0-
+9a-fA-F]+ [;] $
        /package Parse::Marpa::<PACKAGE>;/xms;
    $template =~ s/ \s* at \s [^\s]* code_diag[.]t \s line  \s \d+\Z//
+xms;
    $template =~ s/[<]WHERE[>]/$where/xmsg;
    $template =~ s/[<]LONG_WHERE[>]/$long_where/xmsg;
    $template =~ s/ \s [<]DATA[>] \s line \s \d+
            / <DATA> line <LINE_NO>/xmsg;
    $template
        =~ s/
            \s at \s [(] eval \s \d+ [)] \s line \s
            / at (eval <LINE_NO>) line /xmsg;
    return $template;
}

sub run_test {
    my $args = shift;

    my $E_Op_action = $good_code{e_op_action};
    my $E_Number_action = $good_code{e_number_action};
    my $preamble = q{1};
    my $lex_preamble = q{1};
    my $default_action = $good_code{default_action};
    my $text_lexer = 'lex_q_quote';
    my $null_action = q{ '[null]' };
    my $default_null_value = q{[default null]};

    while (my ($arg, $value) = each %{$args})
    {
      given(lc $arg) {
        when ('e_op_action') { $E_Op_action = $value }
        when ('e_number_action') { $E_Number_action = $value }
        when ('default_action') { $default_action = $value }
        when ('lex_preamble') { $lex_preamble = $value }
        when ('preamble') { $preamble = $value }
        when ('lexer') { $text_lexer = $value }
        when ('null_action') { $null_action = $value }
        when ('unstringify_grammar') { return Parse::Marpa::Grammar::u
+nstringify(\$value) }
        when ('unstringify_recce') { return Parse::Marpa::Recognizer::
+unstringify(\$value) }
        default { croak("unknown argument to run_test: $arg"); }
      }
    }

    my $grammar = new Parse::Marpa::Grammar({
        start => 'S',
        rules => [
            [ 'S', [qw/E trailer optional_trailer1 optional_trailer2/]
+, ],
            [ 'E', [qw/E Op E/], $E_Op_action, ],
            [ 'E', [qw/Number/], $E_Number_action, ],
            [ 'optional_trailer1', [qw/trailer/], ],
            [ 'optional_trailer1', [], ],
            [ 'optional_trailer2', [], $null_action ],
            [ 'trailer', [qw/Text/], ],
        ],
        terminals => [
            [ 'Number' => { regex => qr/\d+/xms } ],
            [ 'Op' => { regex => qr/[-+*]/xms } ],
            [ 'Text' => { action => $text_lexer } ],
        ],
        default_action => $default_action,
        preamble => $preamble,
        lex_preamble => $lex_preamble,
        default_lex_prefix => '\s*',
        default_null_value => $default_null_value,
    });

    my $recce = new Parse::Marpa::Recognizer({grammar => $grammar});

    my $fail_offset = $recce->text( '2 - 0 * 3 + 1 q{trailer}' );
    if ( $fail_offset >= 0 ) {
        croak("Parse failed at offset $fail_offset");
    }

    $recce->end_input();

    my $expected = '((((2-0)*3)+1)==7; q{trailer};[default null];[null
+])';
    my $evaler = new Parse::Marpa::Evaluator( { recce => $recce } );
    my $value = $evaler->value();
    Marpa::Test::is(${$value}, $expected, 'Ambiguous Equation Value');

    return 1;

} # sub run_test

run_test({});

my %where = (
    preamble => 'evaluating preamble',
    lex_preamble => 'evaluating lex preamble',
    e_op_action => 'compiling action',
    default_action => 'compiling action',
    null_action => 'evaluating null value',
    lexer => 'compiling lexer',
    unstringify_grammar => 'unstringifying grammar',
    unstringify_recce => 'unstringifying recognizer',
);

my %long_where = (
    preamble => 'evaluating preamble',
    lex_preamble => 'evaluating lex preamble',
    e_op_action => 'compiling action for 1: E -> E Op E',
    default_action => 'compiling action for 3: optional_trailer1 -> tr
+ailer',
    null_action => 'evaluating null value for optional_trailer2',
    lexer => 'compiling lexer for Text',
    unstringify_grammar => 'unstringifying grammar',
    unstringify_recce => 'unstringifying recognizer',
);

for my $test (@tests)
{
    for my $feature (@features)
    {
        my $test_name = "$test in $feature";
        if (eval {
            run_test({
                $feature => $test_code{$test},
            });
        })
        {
           fail("$test_name did not fail -- that shouldn't happen");
        } else {
            my $eval_error = $EVAL_ERROR;
            my $where = $where{$feature};
            my $long_where = $long_where{$feature};
            Marpa::Test::is(
                canonical($eval_error, $where, $long_where),
                canonical($expected{$test}{$feature}, $where, $long_wh
+ere),
                $test_name
            );
        }
    }
}

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4:

__DATA__
| bad code compile phase warning
# this should be a compile phase warning
my $x = 0;
my $x = 1;
my $x = 2;
$x++;
1;
__END__

| expected preamble compile phase warning
| expected lex_preamble compile phase warning
Fatal problem(s) in <LONG_WHERE>
2 Warning(s)
Warning(s) treated as fatal problem
Last warning occurred in this code:
2: # this should be a compile phase warning
3: my $x = 0;
*4: my $x = 1;
*5: my $x = 2;
6: $x++;
7: 1;
======
Warning #0 in <WHERE>:
"my" variable $x masks earlier declaration in same scope at (eval <LIN
+E_NO>) line 4, <DATA> line 1.
======
Warning #1 in <WHERE>:
"my" variable $x masks earlier declaration in same scope at (eval <LIN
+E_NO>) line 5, <DATA> line 1.
======
__END__

| expected unstringify_grammar compile phase warning
| expected unstringify_recce compile phase warning
Fatal problem(s) in <LONG_WHERE>
2 Warning(s)
Warning(s) treated as fatal problem
Last warning occurred in this code:
1: # this should be a compile phase warning
2: my $x = 0;
*3: my $x = 1;
*4: my $x = 2;
5: $x++;
6: 1;
======
Warning #0 in <WHERE>:
"my" variable $x masks earlier declaration in same scope at (eval <LIN
+E_NO>) line 3, <DATA> line 1.
======
Warning #1 in <WHERE>:
"my" variable $x masks earlier declaration in same scope at (eval <LIN
+E_NO>) line 4, <DATA> line 1.
======
__END__

| expected e_op_action compile phase warning
| expected default_action compile phase warning
Fatal problem(s) in <LONG_WHERE>
2 Warning(s)
Warning(s) treated as fatal problem
Last warning occurred in this code:
3: # this should be a compile phase warning
4: my $x = 0;
*5: my $x = 1;
*6: my $x = 2;
7: $x++;
8: 1;
9: }
======
Warning #0 in <WHERE>:
"my" variable $x masks earlier declaration in same scope at (eval <LIN
+E_NO>) line 5, <DATA> line 1.
======
Warning #1 in <WHERE>:
"my" variable $x masks earlier declaration in same scope at (eval <LIN
+E_NO>) line 6, <DATA> line 1.
======
__END__

| expected null_action compile phase warning
Fatal problem(s) in <LONG_WHERE>
2 Warning(s)
Warning(s) treated as fatal problem
Last warning occurred in this code:
3: # this should be a compile phase warning
4: my $x = 0;
*5: my $x = 1;
*6: my $x = 2;
7: $x++;
8: 1;
======
Warning #0 in <WHERE>:
"my" variable $x masks earlier declaration in same scope at (eval <LIN
+E_NO>) line 5, <DATA> line 1.
======
Warning #1 in <WHERE>:
"my" variable $x masks earlier declaration in same scope at (eval <LIN
+E_NO>) line 6, <DATA> line 1.
======
__END__

| expected lexer compile phase warning
Fatal problem(s) in <LONG_WHERE>
2 Warning(s)
Warning(s) treated as fatal problem
Last warning occurred in this code:
5:     # this should be a compile phase warning
6: my $x = 0;
*7: my $x = 1;
*8: my $x = 2;
9: $x++;
10: 1;
11: ;
======
Warning #0 in <WHERE>:
"my" variable $x masks earlier declaration in same scope at (eval <LIN
+E_NO>) line 7, <DATA> line 1.
======
Warning #1 in <WHERE>:
"my" variable $x masks earlier declaration in same scope at (eval <LIN
+E_NO>) line 8, <DATA> line 1.
======
__END__

| bad code compile phase fatal
# this should be a compile phase error
my $x = 0;
$x=;
$x++;
1;
__END__

| expected preamble compile phase fatal
| expected lex_preamble compile phase fatal
Fatal problem(s) in <LONG_WHERE>
Fatal Error
Problem code begins:
1: package Parse::Marpa::<PACKAGE>;
2: # this should be a compile phase error
3: my $x = 0;
4: $x=;
5: $x++;
6: 1;
======
Error in <WHERE>:
syntax error at (eval <LINE_NO>) line 4, at EOF
======
__END__

| expected unstringify_grammar compile phase fatal
| expected unstringify_recce compile phase fatal
Fatal problem(s) in <LONG_WHERE>
Fatal Error
Problem code begins:
1: # this should be a compile phase error
2: my $x = 0;
3: $x=;
4: $x++;
5: 1;
======
Error in <WHERE>:
syntax error at (eval <LINE_NO>) line 3, at EOF
======
__END__

| expected e_op_action compile phase fatal
| expected default_action compile phase fatal
Fatal problem(s) in <LONG_WHERE>
Fatal Error
Problem code begins:
1: sub {
2:     package Parse::Marpa::<PACKAGE>;
3: # this should be a compile phase error
4: my $x = 0;
5: $x=;
6: $x++;
7: 1;
======
Error in <WHERE>:
syntax error at (eval <LINE_NO>) line 5, at EOF
======
__END__

| expected null_action compile phase fatal
Fatal problem(s) in <LONG_WHERE>
Fatal Error
Problem code begins:
1: package Parse::Marpa::<PACKAGE>;
2: @_=();
3: # this should be a compile phase error
4: my $x = 0;
5: $x=;
6: $x++;
7: 1;
======
Error in <WHERE>:
syntax error at (eval <LINE_NO>) line 5, at EOF
======
__END__

| expected lexer compile phase fatal
Fatal problem(s) in <LONG_WHERE>
Fatal Error
Problem code begins:
1: sub {
2:     my $STRING = shift;
3:     my $START = shift;
4:     package Parse::Marpa::<PACKAGE>;
5:     # this should be a compile phase error
6: my $x = 0;
7: $x=;
======
Error in <WHERE>:
syntax error at (eval <LINE_NO>) line 7, at EOF
======
__END__

| bad code run phase warning
# this should be a run phase warning
my $x = 0;
warn "Test Warning 1";
warn "Test Warning 2";
$x++;
1;
__END__

| expected preamble run phase warning
| expected lex_preamble run phase warning
Fatal problem(s) in <LONG_WHERE>
2 Warning(s)
Warning(s) treated as fatal problem
Last warning occurred in this code:
2: # this should be a run phase warning
3: my $x = 0;
*4: warn "Test Warning 1";
*5: warn "Test Warning 2";
6: $x++;
7: 1;
======
Warning #0 in <WHERE>:
Test Warning 1 at (eval <LINE_NO>) line 4, <DATA> line <LINE_NO>.
======
Warning #1 in <WHERE>:
Test Warning 2 at (eval <LINE_NO>) line 5, <DATA> line <LINE_NO>.
======
__END__

| expected unstringify_grammar run phase warning
| expected unstringify_recce run phase warning
Fatal problem(s) in <LONG_WHERE>
2 Warning(s)
Warning(s) treated as fatal problem
Last warning occurred in this code:
1: # this should be a run phase warning
2: my $x = 0;
*3: warn "Test Warning 1";
*4: warn "Test Warning 2";
5: $x++;
6: 1;
======
Warning #0 in <WHERE>:
Test Warning 1 at (eval <LINE_NO>) line 3, <DATA> line <LINE_NO>.
======
Warning #1 in <WHERE>:
Test Warning 2 at (eval <LINE_NO>) line 4, <DATA> line <LINE_NO>.
======
__END__

| expected e_op_action run phase warning
Fatal problem(s) in computing value for rule: 1: E -> E Op E
2 Warning(s)
Warning(s) treated as fatal problem
Last warning occurred in this code:
3: # this should be a run phase warning
4: my $x = 0;
*5: warn "Test Warning 1";
*6: warn "Test Warning 2";
7: $x++;
8: 1;
9: }
======
Warning #0 in computing value:
Test Warning 1 at (eval <LINE_NO>) line 5, <DATA> line <LINE_NO>.
======
Warning #1 in computing value:
Test Warning 2 at (eval <LINE_NO>) line 6, <DATA> line <LINE_NO>.
======
__END__

| expected default_action run phase warning
Fatal problem(s) in computing value for rule: 6: trailer -> Text

2 Warning(s)
Warning(s) treated as fatal problem
Last warning occurred in this code:
3: # this should be a run phase warning
4: my $x = 0;
*5: warn "Test Warning 1";
*6: warn "Test Warning 2";
7: $x++;
8: 1;
9: }
======
Warning #0 in computing value:
Test Warning 1 at (eval <LINE_NO>) line 5, <DATA> line <LINE_NO>.
======
Warning #1 in computing value:
Test Warning 2 at (eval <LINE_NO>) line 6, <DATA> line <LINE_NO>.
======
__END__

| expected null_action run phase warning
Fatal problem(s) in <LONG_WHERE>
2 Warning(s)
Warning(s) treated as fatal problem
Last warning occurred in this code:
3: # this should be a run phase warning
4: my $x = 0;
*5: warn "Test Warning 1";
*6: warn "Test Warning 2";
7: $x++;
8: 1;
======
Warning #0 in <WHERE>:
Test Warning 1 at (eval <LINE_NO>) line 5, <DATA> line <LINE_NO>.
======
Warning #1 in <WHERE>:
Test Warning 2 at (eval <LINE_NO>) line 6, <DATA> line <LINE_NO>.
======
__END__

| expected lexer run phase warning
Fatal problem(s) in user supplied lexer for Text at 1
2 Warning(s)
Warning(s) treated as fatal problem
Last warning occurred in this code:
5:     # this should be a run phase warning
6: my $x = 0;
*7: warn "Test Warning 1";
*8: warn "Test Warning 2";
9: $x++;
10: 1;
11: ;
======
Warning #0 in user supplied lexer:
Test Warning 1 at (eval <LINE_NO>) line 7, <DATA> line <LINE_NO>.
======
Warning #1 in user supplied lexer:
Test Warning 2 at (eval <LINE_NO>) line 8, <DATA> line <LINE_NO>.
======
__END__

| bad code run phase error
# this should be a run phase error
my $x = 0;
$x = 711/0;
$x++;
1;
__END__

| expected preamble run phase error
| expected lex_preamble run phase error
Fatal problem(s) in <LONG_WHERE>
Fatal Error
Problem code begins:
1: package Parse::Marpa::<PACKAGE>;
2: # this should be a run phase error
3: my $x = 0;
4: $x = 711/0;
5: $x++;
6: 1;
======
Error in <WHERE>:
Illegal division by zero at (eval <LINE_NO>) line 4, <DATA> line <LINE
+_NO>.
======
__END__

| expected unstringify_grammar run phase error
| expected unstringify_recce run phase error
Fatal problem(s) in <LONG_WHERE>
Fatal Error
Problem code begins:
1: # this should be a run phase error
2: my $x = 0;
3: $x = 711/0;
4: $x++;
5: 1;
======
Error in <WHERE>:
Illegal division by zero at (eval <LINE_NO>) line 3, <DATA> line <LINE
+_NO>.
======
__END__

| expected e_op_action run phase error
Fatal problem(s) in computing value for rule: 1: E -> E Op E
Fatal Error
Problem code begins:
1: sub {
2:     package Parse::Marpa::<PACKAGE>;
3: # this should be a run phase error
4: my $x = 0;
5: $x = 711/0;
6: $x++;
7: 1;
======
Error in computing value:
Illegal division by zero at (eval <LINE_NO>) line 5, <DATA> line <LINE
+_NO>.
======
__END__

| expected default_action run phase error
Fatal problem(s) in computing value for rule: 6: trailer -> Text
Fatal Error
Problem code begins:
1: sub {
2:     package Parse::Marpa::<PACKAGE>;
3: # this should be a run phase error
4: my $x = 0;
5: $x = 711/0;
6: $x++;
7: 1;
======
Error in computing value:
Illegal division by zero at (eval <LINE_NO>) line 5, <DATA> line <LINE
+_NO>.
======
__END__

| expected null_action run phase error
Fatal problem(s) in <LONG_WHERE>
Fatal Error
Problem code begins:
1: package Parse::Marpa::<PACKAGE>;
2: @_=();
3: # this should be a run phase error
4: my $x = 0;
5: $x = 711/0;
6: $x++;
7: 1;
======
Error in <WHERE>:
Illegal division by zero at (eval <LINE_NO>) line 5, <DATA> line <LINE
+_NO>.
======
__END__

| expected lexer run phase error
Fatal problem(s) in user supplied lexer for Text at 1
Fatal Error
Problem code begins:
1: sub {
2:     my $STRING = shift;
3:     my $START = shift;
4:     package Parse::Marpa::<PACKAGE>;
5:     # this should be a run phase error
6: my $x = 0;
7: $x = 711/0;
======
Error in user supplied lexer:
Illegal division by zero at (eval <LINE_NO>) line 7, <DATA> line <LINE
+_NO>.
======
__END__

| bad code run phase die
# this is a call to die()
my $x = 0;
die('test call to die');
$x++;
1;
__END__

| expected preamble run phase die
| expected lex_preamble run phase die
Fatal problem(s) in <LONG_WHERE>
Fatal Error
Problem code begins:
1: package Parse::Marpa::<PACKAGE>;
2: # this is a call to die()
3: my $x = 0;

4: die('test call to die');
5: $x++;
6: 1;
======
Error in <WHERE>:
test call to die at (eval <LINE_NO>) line 4, <DATA> line <LINE_NO>.
======
__END__

| expected unstringify_grammar run phase die
| expected unstringify_recce run phase die
Fatal problem(s) in <LONG_WHERE>
Fatal Error
Problem code begins:
1: # this is a call to die()
2: my $x = 0;
3: die('test call to die');
4: $x++;
5: 1;
======
Error in <WHERE>:
test call to die at (eval <LINE_NO>) line 3, <DATA> line <LINE_NO>.
======
__END__

| expected e_op_action run phase die
Fatal problem(s) in computing value for rule: 1: E -> E Op E
Fatal Error
Problem code begins:
1: sub {
2:     package Parse::Marpa::<PACKAGE>;
3: # this is a call to die()
4: my $x = 0;
5: die('test call to die');
6: $x++;
7: 1;
======
Error in computing value:
test call to die at (eval <LINE_NO>) line 5, <DATA> line <LINE_NO>.
======
__END__

| expected default_action run phase die
Fatal problem(s) in computing value for rule: 6: trailer -> Text
Fatal Error
Problem code begins:
1: sub {
2:     package Parse::Marpa::<PACKAGE>;
3: # this is a call to die()
4: my $x = 0;
5: die('test call to die');
6: $x++;
7: 1;
======
Error in computing value:
test call to die at (eval <LINE_NO>) line 5, <DATA> line <LINE_NO>.
======
__END__

| expected null_action run phase die
Fatal problem(s) in <LONG_WHERE>
Fatal Error
Problem code begins:
1: package Parse::Marpa::<PACKAGE>;
2: @_=();
3: # this is a call to die()
4: my $x = 0;
5: die('test call to die');
6: $x++;
7: 1;
======
Error in <WHERE>:
test call to die at (eval <LINE_NO>) line 5, <DATA> line <LINE_NO>.
======
__END__

| expected lexer run phase die
Fatal problem(s) in user supplied lexer for Text at 1
Fatal Error
Problem code begins:
1: sub {
2:     my $STRING = shift;
3:     my $START = shift;
4:     package Parse::Marpa::<PACKAGE>;
5:     # this is a call to die()
6: my $x = 0;
7: die('test call to die');
======
Error in user supplied lexer:
test call to die at (eval <LINE_NO>) line 7, <DATA> line <LINE_NO>.
======
__END__


| good code e_op_action
my ($right_string, $right_value)
    = ($_[2] =~ /^(.*)==(.*)$/);
my ($left_string, $left_value)
    = ($_[0] =~ /^(.*)==(.*)$/);
my $op = $_[1];
my $value;
if ($op eq '+') {
   $value = $left_value + $right_value;
} elsif ($op eq '*') {
   $value = $left_value * $right_value;
} elsif ($op eq '-') {
   $value = $left_value - $right_value;
} else {
   croak("Unknown op: $op");
}
'(' . $left_string . $op . $right_string . ')==' . $value;
__END__

| good code e_number_action
my $v0 = pop @_;
$v0 . q{==} . $v0;
__END__

| good code default_action
my $v_count = scalar @_;
return q{} if $v_count <= 0;
return $_[0] if $v_count == 1;
'(' . join(q{;}, (map { $_ // 'undef' } @_)) . ')';
__END__

[samtregar]

Other ways code can fail, for various definitions of failure:
• It could loop infinitely, never returning.
• It could run out of memory and get killed by the OS.
• It could crash your operating system.
• It could call exit() or more powerfully POSIX::exit().
• It could seg-fault and dump core, for example by calling CORE::dump() or by hitting a bug in Perl.

-sam

[Jeffrey Kegler]

This was quite useful. In my case and I think many cases, none of these are worth coding for because of one or more of:
1. Not decidable in the general case.
2. A lot of overhead to decide in special cases.
3. Not catchable in Perl.
4. Catchable, but to do so is much more likely to get in the user's way than to help her.

But it's a very nicely itemized list and it's a useful exercise every time a programmer encounters a new type of application for her to think out each of these cases, to see if she is doing all she can to help her users. I found thinking it over very useful. Thanks.

You might consider extending this list with your redaction of my basic cases, plus Larry Wall's "lightning bolt from Zeus" as mentioned in his description of Hubris as one of the programmer's virtues, and posting it as a Meditation. I'd find it useful for reference.

[kyle]

For testing purposes, I'd say wrap up all the stuff you'd like to do with user-supplied eval code into one sub (or module) and then just test that. Then you don't have to have tests for eight (or more) places in your code that uses it.

As for your list of things to check for, I'd say it's pretty complete except that the value returned from eval doesn't really mean much and the $EVAL_ERROR isn't very reliable.

To see why $EVAL_ERROR is not reliable, see Acme::ExceptionEater.

The value returned from eval doesn't mean much because the user-supplied code can make it whatever it wants. That's because return works inside eval just as if it were in a sub.

my $code_from_user = "return undef;";
my $success = eval "$code_from_user; 1";
# oops, $success looks like failure!

Update: If you want to catch a die that the user called vs. a die from a run-time error (such as division by zero), I think you'd have to override CORE::GLOBAL::die to report when it's called.

[mikelieman]

FTFD:

In both forms, the value returned is the value of the last expression evaluated inside the mini-program; a return statement may be also used, just as with subroutines. The expression providing the return value is evaluated in void, scalar, or list context, depending on the context of the eval itself. See "wantarray" for more on how the evaluation context can be determined.

If there is a syntax error or runtime error, or a die statement is executed, an undefined value is returned by eval, and $@ is set to the error message. If there was no error, $@ is guaranteed to be a null string. Beware that using eval neither silences perl from printing warnings to STDERR, nor does it stuff the text of warning messages into $@ . To do either of those, you have to use the $SIG{__WARN__} facility, or turn off warnings inside the BLOCK or EXPR using no warnings 'all' .

1. Check for eval returning undef + $@ != null.
2. setup $SIG{__WARN__} to inform you when a warning's going to print.

[ikegami]

Check for eval returning undef + $@ != null.

Checking $@ is a bit unreliable. Better:

if (!eval { ...; 1 }) {
   ...error handler...
}

Or if you need the return value:

my $rv;
if (!eval { $rv = ...; 1 }) {
   ...error handler...
}

[diotalevi]

Even better, use tye's Devel::EvalError.

[wol]

Why is using $@ a bit unreliable?

Update: Just found that the answer to this is covered by the documentation of Devel::EvalError. A quick read seems to suggest that the issue can only arise if there's a DESTROY method which uses eval (however indirectly) and doesn't localise $@.

You'll have to decide whether that would be a problem for you...