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
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:
#!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__