#!perl
# Marpa::R3 is Copyright (C) 2016, Jeffrey Kegler.
#
# This module is free software; you can redistribute it and/or modify it
# under the same terms as Perl 5.10.1. For more details, see the full text
# of the licenses in the directory LICENSES.
#
# This program is distributed in the hope that it will be
# useful, but it is provided “as is” and without any express
# or implied warranties. For details, see the full text of
# of the licenses in the directory LICENSES.
# CENSUS: ASIS
# Note: Converted from gabend.t
# Test grammar exceptions -- make sure problems actually
# are detected. These tests are for problems which are supposed
# to abend.
use 5.010001;
use strict;
use warnings;
use English qw( -no_match_vars );
use Test::More tests => 9;
use Fatal qw(open close);
use lib 'inc';
use Marpa::R3::Test;
use Marpa::R3;
## 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
sub test_grammar {
my ( $test_name, $dsl, $expected_error ) = @_;
my $trace;
my $memory;
my $eval_ok = eval {
my $grammar = Marpa::R3::Scanless::G->new( { source => \$dsl } );
1;
};
my $eval_error = $EVAL_ERROR;
if ($eval_ok) {
Test::More::fail("Failed to catch problem: $test_name");
}
else {
$eval_error =~ s/ ^ Marpa::R3 \s+ exception \s+ at \s+ .* \z //xms;
Marpa::R3::Test::is( $eval_error, $expected_error,
"Successfully caught problem: $test_name" );
}
return;
}
if (1) {
my $counted_nullable_grammar = <<'END_OF_DSL';
S ::= Seq*
Seq ::= A B
A ::=
B ::=
A ~ [\d\D]
END_OF_DSL
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}
);
}
if (1) {
my $duplicate_rule_grammar = <<'END_OF_DSL';
Top ::= Dup
Dup ::= Item
Dup ::= Item
Item ::= a
END_OF_DSL
test_grammar( 'duplicate rule',
$duplicate_rule_grammar, <<'EOS');
========= Marpa::R3 Fatal error =========
Duplicate rules:
First rule is at line 1, column 5:
Dup ::= Item
Second rule is at line 2, column 5:
Dup ::= Item
=========================================
EOS
}
if (1) {
my $unique_lhs_grammar = <<'END_OF_DSL';
Top ::= Dup
Dup ::= Item*
Dup ::= Item
Item ::= a
END_OF_DSL
test_grammar( 'unique_lhs', $unique_lhs_grammar, <<'EOS');
========= Marpa::R3 Fatal error =========
Duplicate rules:
First rule is at line 1, column 5:
Dup ::= Item*
Second rule is at line 2, column 5:
Dup ::= Item
=========================================
EOS
}
# Duplicate precedenced LHS: 2 precedenced rules
if (1) {
my $unique_lhs_grammar = <<'END_OF_DSL';
Top ::= Dup
Dup ::= Dup '+' Dup || Dup '-' Dup || Item1
Dup ::= Dup '*' Dup || Dup '/' Dup || Item2
Item1 ::= a
Item2 ::= a
a ~ 'a'
END_OF_DSL
test_grammar( 'dup precedenced lhs', $unique_lhs_grammar, <<'EOS');
========= Marpa::R3 Fatal error =========
Precedenced LHS not unique
First precedenced rule is at line 1, column 5:
Dup ::= Dup '+' Dup || Dup '-' Dup || Item1
Second precedenced rule is at line 2, column 5:
Dup ::= Dup '*' Dup || Dup '/' Dup || Item2
=========================================
EOS
}
# Duplicate precedenced LHS: precedenced, then empty
if (1) {
my $unique_lhs_grammar = <<'END_OF_DSL';
Top ::= Dup
Dup ::=
Dup ::= Dup '+' Dup || Dup '-' Dup || Item
Item ::= a
a ~ 'a'
END_OF_DSL
test_grammar( 'LHS empty, then precedenced', $unique_lhs_grammar, <<'EOS');
========= Marpa::R3 Fatal error =========
Precedenced LHS not unique
First rule is at line 1, column 5:
Dup ::=
Second precedenced rule is at line 2, column 5:
Dup ::= Dup '+' Dup || Dup '-' Dup || Item
=========================================
EOS
}
# Duplicate precedenced LHS: precedenced, then empty
if (1) {
my $unique_lhs_grammar = <<'END_OF_DSL';
Top ::= Dup
Dup ::= Dup '+' Dup || Dup '-' Dup || Item1
Dup ::=
Item1 ::= a
a ~ 'a'
END_OF_DSL
test_grammar( 'LHS precedenced, then empty', $unique_lhs_grammar, <<'EOS');
========= Marpa::R3 Fatal error =========
Precedenced LHS not unique
First precedenced rule is at line 1, column 5:
Dup ::= Dup '+' Dup || Dup '-' Dup || Item1
Second rule is at line 2, column 5:
Dup ::=
=========================================
EOS
}
if (1) {
my $nulling_terminal_grammar = <<'END_OF_DSL';
Top ::= Bad
Top ::= Good
Bad ::=
Bad ~ [\d\D]
Good ~ [\d\D]
END_OF_DSL
test_grammar(
'nulling terminal grammar',
$nulling_terminal_grammar,
<<'END_OF_MESSAGE'
A lexeme in L0 is not a lexeme in G1: Bad
END_OF_MESSAGE
);
}
if (1) {
my $start_not_lhs_grammar = <<'END_OF_DSL';
inaccessible is fatal by default
:start ::= Bad
Top ::= Bad
Bad ~ [\d\D]
END_OF_DSL
test_grammar(
'start symbol not on lhs',
$start_not_lhs_grammar,
qq{Inaccessible symbol: Top\n}
);
}
if (1) {
my $unproductive_start_grammar = <<'END_OF_DSL';
:start ::= Bad
Top ::= Bad
Bad ::= Worse
Worse ::= Bad
Top ::= Good
Good ~ [\d\D]
END_OF_DSL
test_grammar(
'unproductive start symbol',
$unproductive_start_grammar,
qq{Unproductive start symbol\n}
);
}
# vim: expandtab shiftwidth=4: