#!perl
use
5.010001;
use
POSIX
qw(setlocale LC_ALL)
;
POSIX::setlocale(LC_ALL,
"C"
);
my
$rules
=
<<'END_OF_GRAMMAR';
:start ::= text
text ::= <text segment>* action => OK
<text segment> ::= subtext
<text segment> ::= <word>
subtext ::= '(' text ')'
event subtext = completed <subtext>
word ~ [\w]+
:discard ~ whitespace
whitespace ~ [\s]+
END_OF_GRAMMAR
my
$grammar
= Marpa::R3::Grammar->new(
{
semantics_package
=>
'My_Actions'
,
source
=> \
$rules
} );
do_test(
$grammar
,
q{42 ( hi 42 hi ) 7 11}
, [
'( hi 42 hi )'
]);
do_test(
$grammar
,
q{42 ( hi) 42 (hi ) 7 11}
, [
'( hi)'
,
'(hi )'
] );
do_test(
$grammar
,
q{(hi 42 hi)}
, [
'(hi 42 hi)'
]);
do_test(
$grammar
,
q{1(2(3(4)))}
, [
qw{ (4) (3(4)) (2(3(4))) }
]);
do_test(
$grammar
,
q{(((1)2)3)4}
, [
qw{(1) ((1)2) (((1)2)3)}
]);
sub
show_last_subtext {
my
(
$recce
) =
@_
;
my
(
$start
,
$length
) =
$recce
->last_completed(
'subtext'
);
return
'No expression was successfully parsed'
if
not
defined
$start
;
return
$recce
->g1_literal(
$start
,
$length
);
}
sub
do_test {
my
(
$grammar
,
$string
,
$expected_events
) =
@_
;
my
@actual_events
;
my
$recce
= Marpa::R3::Recognizer->new(
{
grammar
=>
$grammar
,
event_handlers
=> {
"'default"
=>
sub
() { 'ok' },
"subtext"
=>
sub
() {
my
(
$recce
) =
@_
;
push
@actual_events
, show_last_subtext(
$recce
);
'ok'
;
}
}
}
);
my
$length
=
length
$string
;
my
$pos
=
$recce
->
read
( \
$string
);
while
(
$pos
<
$length
) {
$pos
=
$recce
->resume(
$pos
);
}
my
$value_ref
=
$recce
->value();
if
( not
defined
$value_ref
) {
die
"No parse\n"
;
}
my
$actual_value
= ${
$value_ref
};
Test::More::is(
$actual_value
,
q{1792}
,
qq{Value for "$string"}
);
Test::More::is_deeply( \
@actual_events
,
$expected_events
,
qq{Events for "$string"}
);
}
sub
My_Actions::OK {
return
1792 };