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 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354
|
#!perl
# Copyright 2022 Jeffrey Kegler
# This file is part of Marpa::R2. Marpa::R2 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::R2 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::R2. If not, see
# http://www.gnu.org/licenses/.
# Test of scannerless parsing -- diagnostics
use 5.010001;
use strict;
use warnings;
use Test::More tests => 12;
use English qw( -no_match_vars );
use lib 'inc';
use Marpa::R2::Test;
use Marpa::R2;
my $dsl = <<'END_OF_RULES';
:start ::= Script
Script ::= Calculation* action => do_list
Calculation ::= Expression | ('say') Expression
Expression ::=
Number
| ('+') Expression Expression action => do_add
Number ~ [\d] +
:discard ~ whitespace
whitespace ~ [\s]+
# allow comments
:discard ~ <hash comment>
<hash comment> ~ <terminated hash comment> | <unterminated
final hash comment>
<terminated hash comment> ~ '#' <hash comment body> <vertical space char>
<unterminated final hash comment> ~ '#' <hash comment body>
<hash comment body> ~ <hash comment char>*
<vertical space char> ~ [\x{A}\x{B}\x{C}\x{D}\x{2028}\x{2029}]
<hash comment char> ~ [^\x{A}\x{B}\x{C}\x{D}\x{2028}\x{2029}]
END_OF_RULES
my $grammar = Marpa::R2::Scanless::G->new(
{ action_object => 'My_Actions',
default_action => 'do_arg0',
source => \$dsl,
}
);
my $g0_rules_description;
# Marpa::R2::Display
# name: Scanless g0_rule() synopsis
my @g0_rule_ids = $grammar->g0_rule_ids();
for my $g0_rule_id (@g0_rule_ids) {
$g0_rules_description .= "$g0_rule_id "
. ( join q{ }, map {"<$_>"} $grammar->g0_rule($g0_rule_id) ) . "\n";
}
# Marpa::R2::Display::End
Marpa::R2::Test::is(
$g0_rules_description,
<<'END_OF_DESCRIPTION',
0 <[Lex-0]> <[[s]]> <[[a]]> <[[y]]>
1 <[Lex-1]> <[[\+]]>
2 <Number> <[[\d]]>
3 <[:discard]> <whitespace>
4 <whitespace> <[[\s]]>
5 <[:discard]> <hash comment>
6 <hash comment> <terminated hash comment>
7 <hash comment> <unterminated final hash comment>
8 <terminated hash comment> <[[\#]]> <hash comment body> <vertical space char>
9 <unterminated final hash comment> <[[\#]]> <hash comment body>
10 <hash comment body> <hash comment char>
11 <vertical space char> <[[\x{A}\x{B}\x{C}\x{D}\x{2028}\x{2029}]]>
12 <hash comment char> <[[^\x{A}\x{B}\x{C}\x{D}\x{2028}\x{2029}]]>
13 <[:start_lex]> <Number>
14 <[:start_lex]> <[:discard]>
15 <[:start_lex]> <[Lex-0]>
16 <[:start_lex]> <[Lex-1]>
END_OF_DESCRIPTION
'g0_rule_ids() and g0_rule()'
);
my $g1_rules_description;
# Marpa::R2::Display
# name: Scanless rule() synopsis
my @g1_rule_ids = $grammar->g1_rule_ids();
for my $g1_rule_id (@g1_rule_ids) {
$g1_rules_description .= "$g1_rule_id "
. ( join q{ }, map {"<$_>"} $grammar->rule($g1_rule_id) ) . "\n";
}
# Marpa::R2::Display::End
Marpa::R2::Test::is(
$g1_rules_description,
<<'END_OF_DESCRIPTION',
0 <Script> <Calculation>
1 <Calculation> <Expression>
2 <Calculation> <[Lex-0]> <Expression>
3 <Expression> <Number>
4 <Expression> <[Lex-1]> <Expression> <Expression>
5 <[:start]> <Script>
END_OF_DESCRIPTION
'g1_rule_ids() and rule()'
);
package My_Actions;
# The SELF object is a very awkward way of specifying the per-parse
# argument directly, one which was necessary before the $recce->value()
# method took an argument.
# This way of doing things is discourage and preserved here for testing purposes.
our $SELF;
sub new { return $SELF }
sub do_list {
my ( $self, @results ) = @_;
return +( scalar @results ) . ' results: ' . join q{ }, @results;
}
sub do_add { shift; return $_[0] + $_[1] }
sub do_arg0 { shift; return shift; }
sub show_last_expression {
my ($self) = @_;
my $recce = $self->{recce};
my ( $start, $end ) = $recce->last_completed_range('Expression');
return if not defined $start;
my $last_expression = $recce->range_to_string( $start, $end );
return $last_expression;
} ## end sub show_last_expression
package main;
sub my_parser {
my ( $grammar, $string ) = @_;
my $self = bless { grammar => $grammar }, 'My_Actions';
local $My_Actions::SELF = $self;
my $trace_output = q{};
open my $trace_fh, q{>}, \$trace_output;
my $recce = Marpa::R2::Scanless::R->new(
{ grammar => $grammar,
trace_terminals => 2,
trace_file_handle => $trace_fh,
too_many_earley_items => 100, # test this
}
);
$self->{recce} = $recce;
my ( $parse_value, $parse_status, $last_expression );
my $eval_ok = eval { $recce->read( \$string ); 1 };
close $trace_fh;
if ( not defined $eval_ok ) {
my $abbreviated_error = $EVAL_ERROR;
chomp $abbreviated_error;
$abbreviated_error =~ s/\n.*//xms;
die $self->show_last_expression(), $EVAL_ERROR;
} ## end if ( not defined $eval_ok )
my $value_ref = $recce->value;
if ( not defined $value_ref ) {
die join q{ },
'Input read to end but no parse',
$self->show_last_expression();
}
return $recce, ${$value_ref}, $trace_output;
} ## end sub my_parser
my @tests_data = (
[ '+++ 1 2 3 + + 1 2 4', '1 results: 13', 'Parse OK', 'entire input' ],
);
TEST:
for my $test_data (@tests_data) {
my ($test_string, $expected_value,
$expected_result, $expected_last_expression
) = @{$test_data};
my ( $recce, $actual_value, $trace_output ) =
my_parser( $grammar, $test_string );
# Marpa::R2::Display
# name: Scanless terminals_expected() synopsis
my @terminals_expected = @{$recce->terminals_expected()};
# Marpa::R2::Display::End
Marpa::R2::Test::is(
( join q{ }, sort @terminals_expected ),
'Number [Lex-0] [Lex-1]',
qq{SLIF terminals_expected()}
);
# Marpa::R2::Display
# name: Scanless show_progress() synopsis
my $show_progress_output = $recce->show_progress();
# Marpa::R2::Display::End
Marpa::R2::Test::is( $show_progress_output,
<<'END_OF_EXPECTED_OUTPUT', qq{Scanless show_progess()} );
F0 @0-11 L1c1-19 Script -> Calculation * .
P1 @11-11 L1c19 Calculation -> . Expression
F1 @0-11 L1c1-19 Calculation -> Expression .
P2 @11-11 L1c19 Calculation -> . 'say' Expression
P3 @11-11 L1c19 Expression -> . Number
F3 @10-11 L1c17-19 Expression -> Number .
P4 @11-11 L1c19 Expression -> . '+' Expression Expression
F4 x2 @0,6-11 L1c1-19 Expression -> '+' Expression Expression .
F5 @0-11 L1c1-19 :start -> Script .
END_OF_EXPECTED_OUTPUT
Marpa::R2::Test::is( $actual_value, $expected_value,
qq{Value of "$test_string"} );
Marpa::R2::Test::is( $trace_output,
<<'END_OF_OUTPUT', qq{Trace output for "$test_string"} );
Setting trace_terminals option
Expecting "Number" at earleme 0
Expecting "[Lex-0]" at earleme 0
Expecting "[Lex-1]" at earleme 0
Registering character U+002b '+' as symbol 5: [\+]
Registering character U+002b '+' as symbol 9: [^\x{A}\x{B}\x{C}\x{D}\x{2028}\x{2029}]
Accepted lexeme L1c1 e1: '+'; value="+"
Accepted lexeme L1c2 e2: '+'; value="+"
Accepted lexeme L1c3 e3: '+'; value="+"
Registering character U+0020 as symbol 7: [\s]
Registering character U+0020 as symbol 9: [^\x{A}\x{B}\x{C}\x{D}\x{2028}\x{2029}]
Registering character U+0031 '1' as symbol 6: [\d]
Registering character U+0031 '1' as symbol 9: [^\x{A}\x{B}\x{C}\x{D}\x{2028}\x{2029}]
Discarded lexeme L1c4: whitespace
Accepted lexeme L1c5 e4: Number; value="1"
Registering character U+0032 '2' as symbol 6: [\d]
Registering character U+0032 '2' as symbol 9: [^\x{A}\x{B}\x{C}\x{D}\x{2028}\x{2029}]
Discarded lexeme L1c6: whitespace
Accepted lexeme L1c7 e5: Number; value="2"
Registering character U+0033 '3' as symbol 6: [\d]
Registering character U+0033 '3' as symbol 9: [^\x{A}\x{B}\x{C}\x{D}\x{2028}\x{2029}]
Discarded lexeme L1c8: whitespace
Accepted lexeme L1c9 e6: Number; value="3"
Discarded lexeme L1c10: whitespace
Accepted lexeme L1c11 e7: '+'; value="+"
Discarded lexeme L1c12: whitespace
Accepted lexeme L1c13 e8: '+'; value="+"
Discarded lexeme L1c14: whitespace
Accepted lexeme L1c15 e9: Number; value="1"
Discarded lexeme L1c16: whitespace
Accepted lexeme L1c17 e10: Number; value="2"
Registering character U+0034 '4' as symbol 6: [\d]
Registering character U+0034 '4' as symbol 9: [^\x{A}\x{B}\x{C}\x{D}\x{2028}\x{2029}]
Discarded lexeme L1c18: whitespace
Accepted lexeme L1c19 e11: Number; value="4"
END_OF_OUTPUT
my $expected_progress_output = [
[ 0, -1, 0 ],
[ 1, -1, 0 ],
[ 3, -1, 10 ],
[ 4, -1, 0 ],
[ 4, -1, 6 ],
[ 5, -1, 0 ],
[ 1, 0, 11 ],
[ 2, 0, 11 ],
[ 3, 0, 11 ],
[ 4, 0, 11 ],
];
# Marpa::R2::Display
# name: Scanless progress() synopsis
my $progress_output = $recce->progress();
# Marpa::R2::Display::End
Marpa::R2::Test::is(
Data::Dumper::Dumper($progress_output),
Data::Dumper::Dumper($expected_progress_output),
qq{Scanless progress()}
);
my $latest_g1_location = $recce->latest_g1_location();
Test::More::is( $latest_g1_location, 11, qq{Scanless latest_g1_location()} );
# Marpa::R2::Display
# name: Scanless current_g1_location() synopsis
my $current_g1_location = $recce->current_g1_location();
# Marpa::R2::Display::End
Test::More::is( $current_g1_location, 11, qq{Scanless current_g1_location()} );
# Marpa::R2::Display
# name: SLIF pos() example
my $pos = $recce->pos();
# Marpa::R2::Display::End
Test::More::is( $pos, 19, qq{Scanless pos()} );
# Marpa::R2::Display
# name: SLIF input_length() example
my $input_length = $recce->input_length();
# Marpa::R2::Display::End
Test::More::is( $input_length, 19, qq{Scanless input_length()} );
# Test translation from G1 location to input stream spans
my %location_seen = ();
my @spans = ();
for my $g1_location (
sort { $a <=> $b }
grep { !$location_seen{$_}++; } map { $_->[-1] } @{$progress_output}
)
{
# Marpa::R2::Display
# name: Scanless g1_location_to_span() synopsis
my ( $span_start, $span_length ) =
$recce->g1_location_to_span($g1_location);
# Marpa::R2::Display::End
push @spans, [ $g1_location, $span_start, $span_length ];
} ## end for my $g1_location ( sort { $a <=> $b } grep { !$location_seen...})
# One result for each unique G1 location in progress report
# Format of each result is [g1_location, span_start, span_length]
my $expected_spans =
[ [ 0, 0, 0 ], [ 6, 8, 1 ], [ 10, 16, 1 ], [ 11, 18, 1 ] ];
Test::More::is_deeply( \@spans, $expected_spans,
qq{Scanless g1_location_to_span()} );
} ## end TEST: for my $test_data (@tests_data)
# vim: expandtab shiftwidth=4:
|