#!perl
# Copyright 2014 Jeffrey Kegler
# This file is part of Marpa::R2. Marpa::R2 is free software: you can
# redistribute it and/or modify it under the terms of the GNU Lesser
# General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# Marpa::R2 is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser
# General Public License along with Marpa::R2. If not, see
# http://www.gnu.org/licenses/.
# Test grammar exceptions -- make sure problems actually
# are detected. These tests are for problems which are supposed
# to abend.
use 5.010;
use strict;
use warnings;
use English qw( -no_match_vars );
use Test::More tests => 7;
use Fatal qw(open close);
use lib 'inc';
use Marpa::R2::Test;
use Marpa::R2;
## no critic (Subroutines::RequireArgUnpacking)
sub default_action {
shift;
my $v_count = scalar @_;
return q{} if $v_count <= 0;
return $_[0] if $v_count == 1;
return '(' . join( q{;}, @_ ) . ')';
} ## end sub default_action
## use critic
# NOTE: trace_result not used or tested yet.
sub test_grammar {
my ( $test_name, $grammar_args, $expected_error, $trace_result ) = @_;
my $trace;
my $memory;
my $added_args = {};
if ($trace_result) {
$trace = q{};
## no critic (InputOutput::RequireBriefOpen)
open $memory, q{>}, \$trace;
$added_args = { trace_file_handle => $memory };
} ## end if ($trace_result)
my $eval_ok = eval {
my $grammar = Marpa::R2::Grammar->new( $grammar_args, $added_args );
$grammar->precompute();
1;
};
my $eval_error = $EVAL_ERROR;
defined $trace_result and close $memory;
DETERMINE_TEST_RESULT: {
if ($eval_ok) {
Test::More::fail("Failed to catch problem: $test_name");
last DETERMINE_TEST_RESULT;
}
$eval_error =~ s/ ^ Marpa::R2 \s+ exception \s+ at \s+ .* \z //xms;
if ( $eval_error eq $expected_error ) {
Test::More::pass("Successfully caught problem: $test_name");
last DETERMINE_TEST_RESULT;
}
my $diag_message =
"Failed to find expected message, was expecting:\n";
my $temp;
$temp = $expected_error;
$temp =~ s/^/=== /xmsg;
chomp $temp;
$diag_message .= "$temp\n";
$diag_message .= "This was the message actually received:\n";
$temp = $eval_error;
$temp =~ s/^/=== /xmsg;
chomp $temp;
$diag_message .= "$temp\n";
# $diag_message =~ s/^Marpa::R2 \s+ exception \s+ at .* $//xms;
Test::More::diag($diag_message);
Test::More::fail("Unexpected message: $test_name");
} ## end DETERMINE_TEST_RESULT:
return if not defined $trace_result;
if ( index( $trace, $trace_result ) < 0 ) {
my $diag_message =
"Failed to get expected trace result, was expecting:\n";
my $temp;
$temp = $trace_result;
$temp =~ s/^/=== /xmsg;
chomp $temp;
$diag_message .= "$temp\n";
$diag_message .= "This were the traces actually received:\n";
$temp = $eval_error;
$temp =~ s/^/=== /xmsg;
chomp $temp;
$diag_message .= "$temp\n";
Test::More::diag($diag_message);
Test::More::fail("Unexpected trace: $test_name");
} ## end if ( index( $trace, $trace_result ) < 0 )
else {
Test::More::pass("Tracing OK: $test_name");
}
return;
} ## end sub test_grammar
my $counted_nullable_grammar = {
rules => [
{ lhs => 'S',
rhs => ['Seq'],
min => 0,
},
{ lhs => 'Seq',
rhs => [qw(A B)],
},
{ lhs => 'A' },
{ lhs => 'B' },
],
start => 'S',
};
test_grammar(
'counted nullable',
$counted_nullable_grammar,
qq{Nullable symbol "Seq" is on rhs of counted rule\n}
. qq{Counted nullables confuse Marpa -- please rewrite the grammar\n}
);
my $duplicate_rule_grammar = {
rules => [
{ lhs => 'Top', rhs => ['Dup'] },
{ lhs => 'Dup',
rhs => ['Item'],
},
{ lhs => 'Dup',
rhs => ['Item'],
},
{ lhs => 'Item', rhs => ['a'] },
],
start => 'Top',
};
test_grammar( 'duplicate rule',
$duplicate_rule_grammar, qq{Duplicate rule: Dup -> Item\n} );
my $unique_lhs_grammar = {
rules => [
{ lhs => 'Top', rhs => ['Dup'] },
{ lhs => 'Dup',
rhs => ['Item'],
min => 0,
},
{ lhs => 'Dup',
rhs => ['Item'],
},
{ lhs => 'Item', rhs => ['a'] },
],
start => 'Top',
};
test_grammar( 'unique_lhs',
$unique_lhs_grammar, qq{LHS of sequence rule would not be unique: Dup -> Item\n} );
my $nulling_terminal_grammar = {
rules => [
{ lhs => 'Top', rhs => ['Bad'] },
{ lhs => 'Top', rhs => ['Good'] },
{ lhs => 'Bad', rhs => [] },
],
start => 'Top',
terminals => ['Good', 'Bad'],
};
test_grammar(
'nulling terminal grammar',
$nulling_terminal_grammar,
<<'END_OF_MESSAGE'
Nulling symbol "Bad" is also a terminal
A terminal symbol cannot also be a nulling symbol
END_OF_MESSAGE
);
my $no_start_grammar = {
rules => [ { lhs => 'Top', rhs => ['Bad'] }, ],
terminals => ['Bad'],
};
test_grammar( 'no start symbol', $no_start_grammar, "No start symbol specified in grammar\n" );
my $start_not_lhs_grammar = {
rules => [ { lhs => 'Top', rhs => ['Bad'] }, ],
terminals => ['Bad'],
start => 'Bad',
};
test_grammar( 'start symbol not on lhs',
$start_not_lhs_grammar, qq{Start symbol "Bad" not on LHS of any rule\n} );
my $unproductive_start_grammar = {
rules => [
{ lhs => 'Top', rhs => ['Bad'] },
{ lhs => 'Bad', rhs => ['Worse'] },
{ lhs => 'Worse', rhs => ['Bad'] },
{ lhs => 'Top', rhs => ['Good'] },
],
terminals => ['Good'],
start => 'Bad',
};
test_grammar(
'unproductive start symbol',
$unproductive_start_grammar,
qq{Unproductive start symbol: "Bad"\n}
);
1; # In case used as "do" file
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4: