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

# this should be a compile phase error
my $x = 0;
$x=;
##</code><code>##

# this should be a run phase warning
warn "Test Warning 1";
##</code><code>##

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

##</code><code>##

#!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::unstringify(\$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 -> trailer',
    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_where),
                $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 <LINE_NO>) line 4, <DATA> line 1.
======
Warning #1 in <WHERE>:
"my" variable $x masks earlier declaration in same scope at (eval <LINE_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 <LINE_NO>) line 3, <DATA> line 1.
======
Warning #1 in <WHERE>:
"my" variable $x masks earlier declaration in same scope at (eval <LINE_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 <LINE_NO>) line 5, <DATA> line 1.
======
Warning #1 in <WHERE>:
"my" variable $x masks earlier declaration in same scope at (eval <LINE_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 <LINE_NO>) line 5, <DATA> line 1.
======
Warning #1 in <WHERE>:
"my" variable $x masks earlier declaration in same scope at (eval <LINE_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 <LINE_NO>) line 7, <DATA> line 1.
======
Warning #1 in <WHERE>:
"my" variable $x masks earlier declaration in same scope at (eval <LINE_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__