From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

#!perl
# Marpa::R3 is Copyright (C) 2017, 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.
# This is the displays-focused version of the test of
# named lexeme events deactivation and reactivation
use 5.010001;
use strict;
use English qw( -no_match_vars );
use POSIX qw(setlocale LC_ALL);
POSIX::setlocale(LC_ALL, "C");
use Test::More tests => 2;
# use Test::More skip_all => 'NYI';
use lib 'inc';
my $base_rules = <<'END_OF_GRAMMAR';
:start ::= sequence
sequence ::= char* action => OK
char ::= a | b | c | d
a ~ 'a'
b ~ 'b'
c ~ 'c'
d ~ 'd'
# Marpa::R3::Display
# name: SLIF named lexeme event synopsis
:lexeme ~ <a> pause => before event => 'before a'
:lexeme ~ <b> pause => after event => 'after b'=on
:lexeme ~ <c> pause => before event => 'before c'=off
:lexeme ~ <d> pause => after event => 'after d'
# Marpa::R3::Display::End
END_OF_GRAMMAR
my $rules = $base_rules;
$rules =~ s/=off$//gxms;
# This test the order of events
# No more than one of each event type per line
# so that order is non-arbitrary
my $events_expected = <<'END_OF_EVENTS';
END_OF_EVENTS
my $grammar = Marpa::R3::Scanless::G->new(
{ semantics_package => 'My_Actions', source => \$rules } );
my $expected_events = <<'END_OF_EVENTS';
0 before a
1 before a
3 after b
4 after b
5 after b
5 before c
6 before c
7 before c
9 after d
9 before a
10 before a
11 before a
13 after b
13 before c
14 before c
16 after d
17 after d
18 after d
19 after d
19 before a
21 after b
21 before c
23 after d
END_OF_EVENTS
# Yet another time, with initializers
$expected_events =~ s/^\d+ \s after \s b \n//gxms;
$rules = $base_rules;
$grammar = Marpa::R3::Scanless::G->new(
{
semantics_package => 'My_Actions',
source => \$rules
}
);
my @actual_events = ();
my $current_position;
my $before_handler = sub () {
my ($slr, $event_name) = @_;
my ( $start_of_lexeme, $length_of_lexeme ) = $slr->pause_span();
$current_position = $start_of_lexeme + $length_of_lexeme;
push @actual_events, "$start_of_lexeme $event_name";
'pause';
};
my $after_handler = sub () {
my ($slr, $event_name) = @_;
my ( $start_of_lexeme, $length_of_lexeme ) = $slr->pause_span();
$current_position = $start_of_lexeme + $length_of_lexeme;
push @actual_events, "$current_position $event_name";
'pause';
};
# Marpa::R3::Display
# name: SLIF recce event_is_active named arg example
my $slr = Marpa::R3::Scanless::R->new(
{
grammar => $grammar,
event_is_active => { 'before c' => 1, 'after b' => 0 },
event_handlers => {
'after a' => $after_handler,
'after b' => $after_handler,
'after c' => $after_handler,
'after d' => $after_handler,
'before a' => $before_handler,
'before b' => $before_handler,
'before c' => $before_handler,
'before d' => $before_handler,
}
}
);
# Marpa::R3::Display::End
my $string = q{aabbbcccdaaabccddddabcd};
my $length = length $string;
$slr->read( \$string );
while ($current_position < $length) {
$slr->resume($current_position);
}
my $actual_events .= join "\n", @actual_events, q{};
my $value_ref = $slr->value();
if ( not defined $value_ref ) {
die "No parse\n";
}
my $actual_value = ${$value_ref};
Test::More::is( $actual_value, q{1792}, qq{Value} );
Marpa::R3::Test::is( $actual_events, $expected_events,
qq{Events} );
sub My_Actions::OK { return 1792 }
# vim: expandtab shiftwidth=4: