The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl
# Copyright 2012 Jeffrey Kegler
# This file is part of Marpa::PP.  Marpa::PP 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::PP 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::PP.  If not, see
# http://www.gnu.org/licenses/.
# A grammar with cycles

use 5.010;
use strict;
use warnings;
use English qw( -no_match_vars );
use Fatal qw(open close chdir);

use Test::More tests => 7;
use lib 'tool/lib';
use Marpa::PP::Test;

BEGIN {
    Test::More::use_ok('Marpa::PP');
}

## no critic (Subroutines::RequireArgUnpacking)
sub default_action {
    shift;
    return join q{ }, grep { defined $_ } @_;
}
## use critic

package Test_Grammar;

# Formatted by Data::Dumper, which disagrees with
# perltidy and perlcritic about things
#<<< no perltidy

$Test_Grammar::MARPA_OPTIONS_1 = [
    {   'default_action' => 'main::default_action',
        'rules'          => [
            {   'lhs' => 's',
                'rhs' => [ 's' ]
            }
        ],
        'start'     => 's',
        'terminals' => [ 's' ],
    }
];

$Test_Grammar::MARPA_OPTIONS_2 = [
    {   'default_action' => 'main::default_action',
        'rules'          => [
            {   'lhs' => 's',
                'rhs' => [ 'a' ]
            },
            {   'lhs' => 'a',
                'rhs' => [ 's' ]
            }
        ],
        'start'     => 's',
        'terminals' => [ 'a' ],
    }
];

$Test_Grammar::MARPA_OPTIONS_8 = [
    {   'default_action' => 'main::default_action',
        'rules'          => [
            {   'lhs' => 's',
                'rhs' => [ 'a' ]
            },
            {   'lhs' => 'a',
                'rhs' => [ 'b', 't', 'u' ]
            },
            {   'lhs' => 'b',
                'rhs' => [ 'v', 'c' ]
            },
            {   'lhs' => 'c',
                'rhs' => [ 'w', 'd', 'x' ]
            },
            {   'lhs' => 'd',
                'rhs' => [ 'e' ]
            },
            {   'lhs' => 'e',
                'rhs' => [ 's' ]
            },
            {   'lhs' => 't',
                'rhs' => []
            },
            {   'lhs' => 'u',
                'rhs' => []
            },
            {   'lhs' => 'v',
                'rhs' => []
            },
            {   'lhs' => 'w',
                'rhs' => []
            },
            {   'lhs' => 'x',
                'rhs' => []
            }
        ],
        'start'     => 's',
        'terminals' => [ 'e', 't', 'u', 'v', 'w', 'x' ],
    }
];

#>>>
## use critic

package main;

my $cycle1_test = [
    'cycle1',
    $Test_Grammar::MARPA_OPTIONS_1,
    [ [ [ 's', '1' ] ] ],
    '1',
    <<'EOS'
Cycle found involving rule: 0: s -> s
EOS
];

my $cycle2_test = [
    'cycle2',
    $Test_Grammar::MARPA_OPTIONS_2,
    [ [ [ 'a', '1' ] ] ],
    '1',
    <<'EOS'
Cycle found involving rule: 0: s -> a
Cycle found involving rule: 1: a -> s
EOS
];

my @cycle8_tokens = ( [ [ 'e', '1' ], [ 'v', '1' ], [ 'w', '1' ] ] );

push @cycle8_tokens, map {
    (   [   [ 'e', $_ ],
            [ 't', $_ ],
            [ 'u', $_ ],
            [ 'v', $_ ],
            [ 'w', $_ ],
            [ 'x', $_ ]
        ],
        )
} qw( 2 3 4 5 6 );

my $cycle8_test = [
    'cycle8',
    $Test_Grammar::MARPA_OPTIONS_8,
    \@cycle8_tokens,
    '1 2 3 4 5 6',
    <<'EOS'
Cycle found involving rule: 0: s -> a
Cycle found involving rule: 4: d -> e
Cycle found involving rule: 5: e -> s
Cycle found involving rule: 1: a -> b t u
Cycle found involving rule: 2: b -> v c
Cycle found involving rule: 3: c -> w d x
EOS
];

for my $test_data ( $cycle1_test, $cycle2_test, $cycle8_test ) {
    my ( $test_name, $marpa_options, $input, $expected, $expected_trace ) =
        @{$test_data};
    my $trace = q{};
    open my $MEMORY, '>', \$trace;
    my $grammar = Marpa::PP::Grammar->new(
        {   infinite_action   => 'warn',
            trace_file_handle => $MEMORY,
        },
        @{$marpa_options},
    );
    $grammar->precompute();

    my $recce = Marpa::PP::Recognizer->new( { grammar => $grammar } );
    for my $earleme_input ( @{$input} ) {
        for my $token ( @{$earleme_input} ) {
            $recce->alternative( @{$token} );
        }
        $recce->earleme_complete();
    } ## end for my $earleme_input ( @{$input} )

    my $value_ref = $recce->value();
    my $value = $value_ref ? ${$value_ref} : 'No parse';

    close $MEMORY;

    Marpa::PP::Test::is( $value, $expected,       "$test_name result" );
    Marpa::PP::Test::is( $trace, $expected_trace, "$test_name trace" );

} ## end for my $test_data ( $cycle1_test, $cycle2_test, $cycle8_test)

1;    # In case used as "do" file

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