The Perl Toolchain Summit 2025 Needs You: You can help ๐Ÿ™ Learn more

JKEGL / Marpa-R3-4.001_034 / t / rabend.t 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131

              
#!/usr/bin/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.
# Note: Converted from NAIF rabend.t
use 5.010001;
use strict;
use warnings;
use English qw( -no_match_vars );
use Fatal qw( open close );
use POSIX qw(setlocale LC_ALL);
POSIX::setlocale(LC_ALL, "C");
use Test::More tests => 4;
use lib 'inc';
use Marpa::R3::Test;
use Marpa::R3;
sub catch_problem {
    my ( $test_name, $test, $expected_result, $expected_error ) = @_;
    my $result;
    my $eval_ok = eval {
        $result = $test->();
        1;
    };
    my $eval_error = $EVAL_ERROR;
    Test::More::is( $result, $expected_result, "Result: $test_name" );
    if ($eval_ok) {
        Test::More::fail("Failed to catch problem: $test_name");
    }
    elsif ( index( $eval_error, $expected_error ) < 0 ) {
        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";
        Test::More::diag($diag_message);
        Test::More::fail("Unexpected message: $test_name");
    } ## end elsif ( index( $eval_error, $expected_error ) < 0 )
    else {
        Test::More::pass("Successfully caught problem: $test_name");
    }
    return;
} ## end sub catch_problem
my $grammar = Marpa::R3::Scanless::G->new(
    {
        source => \<<'END_OF_DSL',
Top ::= Term+
Term ::= a
Term ::= b
Term ::= c
Term ::= d
a ~ [\d\D]
b ~ [\d\D]
c ~ [\d\D]
d ~ [\d\D]
END_OF_DSL
    }
);
my $test_name;
my $recce;
# First test that duplicates are Detected
$test_name = 'duplicate terminal 1';
$recce = Marpa::R3::Scanless::R->new( { grammar => $grammar, } );
$recce->read( \'abcd', 0, 0 );
sub duplicate_terminal_1 {
    $recce->lexeme_alternative( 'a', \42 );
    $recce->lexeme_alternative( 'a', \711 );
    $recce->lexeme_complete( 0, 1 );
    return 1;
} ## end sub duplicate_terminal_1
catch_problem( $test_name, \&duplicate_terminal_1, undef, q{Duplicate token} );
# 2nd test that duplicates are Detected
$test_name = 'duplicate terminal 2';
$recce = Marpa::R3::Scanless::R->new( { grammar => $grammar, } );
$recce->read( \'abcd', 0, 0 );
sub duplicate_terminal_2 {
    # Should be OK, because different symbols
    $recce->lexeme_alternative( 'a', \11 )
      or return 'alternative a at 0 failed';
    $recce->lexeme_alternative( 'b', \12 )
      or return 'alternative b at 0 failed';
    $recce->lexeme_complete( 0, 1 );
    $recce->lexeme_alternative( 'd', \42 )
      or return 'first alternative d at 2 failed';
    $recce->lexeme_alternative( 'b', \22 )
      or return 'alternative b at 1 failed';
    # this should cause an abend -- a 2nd d
    return 1 if $recce->lexeme_alternative( 'd', \711 );
    return;
} ## end sub duplicate_terminal_2
catch_problem( $test_name, \&duplicate_terminal_2, undef, q{Duplicate token} );
1;    # In case used as "do" file
# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4: