#!perl
use
5.010001;
use
POSIX
qw(setlocale LC_ALL)
;
POSIX::setlocale(LC_ALL,
"C"
);
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;
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
$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'
;
};
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
,
}
}
);
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 }