1#!/usr/bin/perl 2# Copyright 2012 Jeffrey Kegler 3# This file is part of Marpa::PP. Marpa::PP is free software: you can 4# redistribute it and/or modify it under the terms of the GNU Lesser 5# General Public License as published by the Free Software Foundation, 6# either version 3 of the License, or (at your option) any later version. 7# 8# Marpa::PP is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 11# Lesser General Public License for more details. 12# 13# You should have received a copy of the GNU Lesser 14# General Public License along with Marpa::PP. If not, see 15# http://www.gnu.org/licenses/. 16 17use 5.010; 18use strict; 19use warnings; 20 21# This test case was originally developed as an example 22# for the debugging of grammars with Leo items. Fortunately, 23# I found how to create 24# much more user-friendly tools for debugging these grammars, 25# so now these are simply Leo-oriented regression tests. 26 27use Fatal qw(open close); 28use Test::More tests => 8; 29 30use lib 'tool/lib'; 31use Marpa::PP::Test; 32 33BEGIN { 34 Test::More::use_ok('Marpa::PP'); 35} 36 37## no critic (Subroutines::RequireArgUnpacking) 38 39my $grammar = Marpa::PP::Grammar->new( 40 { start => 'Statement', 41 actions => 'My_Actions', 42 default_action => 'first_arg', 43 strip => 0, 44 rules => [ 45 { lhs => 'Statement', 46 rhs => [qw/Expression/], 47 action => 'do_Statement' 48 }, 49 { lhs => 'Expression', 50 rhs => [qw/Lvalue AssignOp Expression/], 51 action => 'do_Expression' 52 }, 53 { lhs => 'Expression', 54 rhs => [qw/Lvalue AddAssignOp Expression/], 55 action => 'do_Expression' 56 }, 57 { lhs => 'Expression', 58 rhs => [qw/Lvalue MinusAssignOp Expression/], 59 action => 'do_Expression' 60 }, 61 { lhs => 'Expression', 62 rhs => [qw/Lvalue MultiplyAssignOp Expression/], 63 action => 'do_Expression' 64 }, 65 { lhs => 'Expression', 66 rhs => [qw/Variable/], 67 action => 'do_Expression' 68 }, 69 { lhs => 'Lvalue', rhs => [qw/Variable/] }, 70 ], 71 } 72); 73 74$grammar->precompute(); 75 76my $recce = Marpa::PP::Recognizer->new( { grammar => $grammar } ); 77 78$recce->read( 'Variable', 'a' ); 79$recce->read( 'AssignOp', q{=} ); 80$recce->read( 'Variable', 'b' ); 81$recce->read( 'AddAssignOp', q{+=} ); 82$recce->read( 'Variable', 'c' ); 83$recce->read( 'MinusAssignOp', q{-=} ); 84$recce->read( 'Variable', 'd' ); 85$recce->read( 'MultiplyAssignOp', q{*=} ); 86$recce->read( 'Variable', 'e' ); 87 88%My_Actions::VALUES = ( a => 711, b => 47, c => 1, d => 2, e => 3 ); 89 90sub My_Actions::do_Statement { 91 return join q{ }, map { $_ . q{=} . $My_Actions::VALUES{$_} } 92 sort keys %My_Actions::VALUES; 93} 94 95sub My_Actions::do_Expression { 96 my ( undef, $lvariable, $op, $rvalue ) = @_; 97 my $original_value = $My_Actions::VALUES{$lvariable}; 98 return $original_value if not defined $rvalue; 99 return 100 $My_Actions::VALUES{$lvariable} = 101 $op eq q{*=} ? ( $original_value * $rvalue ) 102 : $op eq q{+=} ? ( $original_value + $rvalue ) 103 : $op eq q{-=} ? ( $original_value - $rvalue ) 104 : $rvalue 105 106} ## end sub My_Actions::do_Expression 107 108sub My_Actions::first_arg { return $_[1] } 109 110## use critic 111 112my $show_symbols_output = $grammar->show_symbols(); 113 114Marpa::PP::Test::is( $show_symbols_output, 115 <<'END_SYMBOLS', 'Leo Example Symbols' ); 1160: Statement, lhs=[0] rhs=[7] terminal 1171: Expression, lhs=[1 2 3 4 5] rhs=[0 1 2 3 4] terminal 1182: Lvalue, lhs=[6] rhs=[1 2 3 4] terminal 1193: AssignOp, lhs=[] rhs=[1] terminal 1204: AddAssignOp, lhs=[] rhs=[2] terminal 1215: MinusAssignOp, lhs=[] rhs=[3] terminal 1226: MultiplyAssignOp, lhs=[] rhs=[4] terminal 1237: Variable, lhs=[] rhs=[5 6] terminal 1248: Statement['], lhs=[7] rhs=[] 125END_SYMBOLS 126 127my $show_rules_output = $grammar->show_rules(); 128 129Marpa::PP::Test::is( $show_rules_output, <<'END_RULES', 'Leo Example Rules' ); 1300: Statement -> Expression 1311: Expression -> Lvalue AssignOp Expression 1322: Expression -> Lvalue AddAssignOp Expression 1333: Expression -> Lvalue MinusAssignOp Expression 1344: Expression -> Lvalue MultiplyAssignOp Expression 1355: Expression -> Variable 1366: Lvalue -> Variable 1377: Statement['] -> Statement /* vlhs real=1 */ 138END_RULES 139 140my $show_AHFA_output = $grammar->show_AHFA(); 141 142Marpa::PP::Test::is( $show_AHFA_output, <<'END_AHFA', 'Leo Example AHFA' ); 143* S0: 144Statement['] -> . Statement 145 <Statement> => S2; leo(Statement[']) 146* S1: predict 147Statement -> . Expression 148Expression -> . Lvalue AssignOp Expression 149Expression -> . Lvalue AddAssignOp Expression 150Expression -> . Lvalue MinusAssignOp Expression 151Expression -> . Lvalue MultiplyAssignOp Expression 152Expression -> . Variable 153Lvalue -> . Variable 154 <Expression> => S3; leo(Statement) 155 <Lvalue> => S4 156 <Variable> => S5 157* S2: leo-c 158Statement['] -> Statement . 159* S3: leo-c 160Statement -> Expression . 161* S4: 162Expression -> Lvalue . AssignOp Expression 163Expression -> Lvalue . AddAssignOp Expression 164Expression -> Lvalue . MinusAssignOp Expression 165Expression -> Lvalue . MultiplyAssignOp Expression 166 <AddAssignOp> => S7; S8 167 <AssignOp> => S6; S7 168 <MinusAssignOp> => S7; S9 169 <MultiplyAssignOp> => S10; S7 170* S5: 171Expression -> Variable . 172Lvalue -> Variable . 173* S6: 174Expression -> Lvalue AssignOp . Expression 175 <Expression> => S11; leo(Expression) 176* S7: predict 177Expression -> . Lvalue AssignOp Expression 178Expression -> . Lvalue AddAssignOp Expression 179Expression -> . Lvalue MinusAssignOp Expression 180Expression -> . Lvalue MultiplyAssignOp Expression 181Expression -> . Variable 182Lvalue -> . Variable 183 <Lvalue> => S4 184 <Variable> => S5 185* S8: 186Expression -> Lvalue AddAssignOp . Expression 187 <Expression> => S12; leo(Expression) 188* S9: 189Expression -> Lvalue MinusAssignOp . Expression 190 <Expression> => S13; leo(Expression) 191* S10: 192Expression -> Lvalue MultiplyAssignOp . Expression 193 <Expression> => S14; leo(Expression) 194* S11: leo-c 195Expression -> Lvalue AssignOp Expression . 196* S12: leo-c 197Expression -> Lvalue AddAssignOp Expression . 198* S13: leo-c 199Expression -> Lvalue MinusAssignOp Expression . 200* S14: leo-c 201Expression -> Lvalue MultiplyAssignOp Expression . 202END_AHFA 203 204my $show_earley_sets_output_before = $recce->show_earley_sets(); 205 206Marpa::PP::Test::is( $show_earley_sets_output_before, 207 <<'END_EARLEY_SETS', 'Leo Example Earley Sets "Before"' ); 208Last Completed: 9; Furthest: 9 209Earley Set 0 210S0@0-0 211S1@0-0 212Earley Set 1 213S2@0-1 [p=S0@0-0; c=S3@0-1] 214S3@0-1 [p=S1@0-0; c=S5@0-1] 215S4@0-1 [p=S1@0-0; c=S5@0-1] 216S5@0-1 [p=S1@0-0; s=Variable; t=\'a'] 217Earley Set 2 218S6@0-2 [p=S4@0-1; s=AssignOp; t=\'='] 219S7@2-2 220L1@2 ["Expression"; S6@0-2] 221Earley Set 3 222S2@0-3 [p=S0@0-0; c=S3@0-3] 223S3@0-3 [p=S1@0-0; c=S11@0-3] 224S11@0-3 [l=L1@2; c=S5@2-3] 225S4@2-3 [p=S7@2-2; c=S5@2-3] 226S5@2-3 [p=S7@2-2; s=Variable; t=\'b'] 227Earley Set 4 228S8@2-4 [p=S4@2-3; s=AddAssignOp; t=\'+='] 229S7@4-4 230L1@4 ["Expression"; L1@2; S8@2-4] 231Earley Set 5 232S2@0-5 [p=S0@0-0; c=S3@0-5] 233S3@0-5 [p=S1@0-0; c=S11@0-5] 234S11@0-5 [l=L1@4; c=S5@4-5] 235S4@4-5 [p=S7@4-4; c=S5@4-5] 236S5@4-5 [p=S7@4-4; s=Variable; t=\'c'] 237Earley Set 6 238S9@4-6 [p=S4@4-5; s=MinusAssignOp; t=\'-='] 239S7@6-6 240L1@6 ["Expression"; L1@4; S9@4-6] 241Earley Set 7 242S2@0-7 [p=S0@0-0; c=S3@0-7] 243S3@0-7 [p=S1@0-0; c=S11@0-7] 244S11@0-7 [l=L1@6; c=S5@6-7] 245S4@6-7 [p=S7@6-6; c=S5@6-7] 246S5@6-7 [p=S7@6-6; s=Variable; t=\'d'] 247Earley Set 8 248S10@6-8 [p=S4@6-7; s=MultiplyAssignOp; t=\'*='] 249S7@8-8 250L1@8 ["Expression"; L1@6; S10@6-8] 251Earley Set 9 252S2@0-9 [p=S0@0-0; c=S3@0-9] 253S3@0-9 [p=S1@0-0; c=S11@0-9] 254S11@0-9 [l=L1@8; c=S5@8-9] 255S4@8-9 [p=S7@8-8; c=S5@8-9] 256S5@8-9 [p=S7@8-8; s=Variable; t=\'e'] 257END_EARLEY_SETS 258 259my $trace_output; 260open my $trace_fh, q{>}, \$trace_output; 261my $value_ref = $recce->value( { trace_fh => $trace_fh, trace_values => 1 } ); 262close $trace_fh; 263 264my $value = ref $value_ref ? ${$value_ref} : 'No Parse'; 265Marpa::PP::Test::is( $value, 'a=42 b=42 c=-5 d=6 e=3', 'Leo Example Value' ); 266 267my $show_earley_sets_output_after = $recce->show_earley_sets(); 268 269SKIP: { 270 Test::More::skip 'Not relevant to XS', 1 if defined $Marpa::XS::VERSION; 271 Marpa::PP::Test::is( $show_earley_sets_output_after, 272 <<'END_EARLEY_SETS', 'Leo Example Earley Sets "After"' ); 273Last Completed: 9; Furthest: 9 274Earley Set 0 275S0@0-0 276S1@0-0 277Earley Set 1 278S2@0-1 [p=S0@0-0; c=S3@0-1] 279S3@0-1 [p=S1@0-0; c=S5@0-1] 280S4@0-1 [p=S1@0-0; c=S5@0-1] 281S5@0-1 [p=S1@0-0; s=Variable; t=\'a'] 282Earley Set 2 283S6@0-2 [p=S4@0-1; s=AssignOp; t=\'='] 284S7@2-2 285L1@2 ["Expression"; S6@0-2] 286Earley Set 3 287S2@0-3 [p=S0@0-0; c=S3@0-3] 288S3@0-3 [p=S1@0-0; c=S11@0-3] 289S11@0-3 [l=L1@2; c=S5@2-3] 290S4@2-3 [p=S7@2-2; c=S5@2-3] 291S5@2-3 [p=S7@2-2; s=Variable; t=\'b'] 292Earley Set 4 293S8@2-4 [p=S4@2-3; s=AddAssignOp; t=\'+='] 294S7@4-4 295L1@4 ["Expression"; L1@2; S8@2-4] 296Earley Set 5 297S2@0-5 [p=S0@0-0; c=S3@0-5] 298S3@0-5 [p=S1@0-0; c=S11@0-5] 299S11@0-5 [l=L1@4; c=S5@4-5] 300S4@4-5 [p=S7@4-4; c=S5@4-5] 301S5@4-5 [p=S7@4-4; s=Variable; t=\'c'] 302Earley Set 6 303S9@4-6 [p=S4@4-5; s=MinusAssignOp; t=\'-='] 304S7@6-6 305L1@6 ["Expression"; L1@4; S9@4-6] 306Earley Set 7 307S2@0-7 [p=S0@0-0; c=S3@0-7] 308S3@0-7 [p=S1@0-0; c=S11@0-7] 309S11@0-7 [l=L1@6; c=S5@6-7] 310S4@6-7 [p=S7@6-6; c=S5@6-7] 311S5@6-7 [p=S7@6-6; s=Variable; t=\'d'] 312Earley Set 8 313S10@6-8 [p=S4@6-7; s=MultiplyAssignOp; t=\'*='] 314S7@8-8 315L1@8 ["Expression"; L1@6; S10@6-8] 316Earley Set 9 317S2@0-9 [p=S0@0-0; c=S3@0-9] 318S3@0-9 [p=S1@0-0; c=S11@0-9] 319S11@0-9 [p=S6@0-2; c=S12@2-9] [l=L1@8; c=S5@8-9] 320S12@2-9 [p=S8@2-4; c=S13@4-9] 321S13@4-9 [p=S9@4-6; c=S14@6-9] 322S14@6-9 [p=S10@6-8; c=S5@8-9] 323S4@8-9 [p=S7@8-8; c=S5@8-9] 324S5@8-9 [p=S7@8-8; s=Variable; t=\'e'] 325END_EARLEY_SETS 326} ## end SKIP: 327 328my $expected_trace_output = <<'END_TRACE_OUTPUT'; 329Pushed value from R6:1@0-1S7@0: Variable = \'a' 330Popping 1 values to evaluate R6:1@0-1S7@0, rule: 6: Lvalue -> Variable 331Calculated and pushed value: 'a' 332Pushed value from R1:2@0-2S3@1: AssignOp = \'=' 333Pushed value from R6:1@2-3S7@2: Variable = \'b' 334Popping 1 values to evaluate R6:1@2-3S7@2, rule: 6: Lvalue -> Variable 335Calculated and pushed value: 'b' 336Pushed value from R2:2@2-4S4@3: AddAssignOp = \'+=' 337Pushed value from R6:1@4-5S7@4: Variable = \'c' 338Popping 1 values to evaluate R6:1@4-5S7@4, rule: 6: Lvalue -> Variable 339Calculated and pushed value: 'c' 340Pushed value from R3:2@4-6S5@5: MinusAssignOp = \'-=' 341Pushed value from R6:1@6-7S7@6: Variable = \'d' 342Popping 1 values to evaluate R6:1@6-7S7@6, rule: 6: Lvalue -> Variable 343Calculated and pushed value: 'd' 344Pushed value from R4:2@6-8S6@7: MultiplyAssignOp = \'*=' 345Pushed value from R5:1@8-9S7@8: Variable = \'e' 346Popping 1 values to evaluate R5:1@8-9S7@8, rule: 5: Expression -> Variable 347Calculated and pushed value: 3 348Popping 3 values to evaluate R4:3@6-9C5@8, rule: 4: Expression -> Lvalue MultiplyAssignOp Expression 349Calculated and pushed value: 6 350Popping 3 values to evaluate R3:3@4-9C4@6, rule: 3: Expression -> Lvalue MinusAssignOp Expression 351Calculated and pushed value: -5 352Popping 3 values to evaluate R2:3@2-9C3@4, rule: 2: Expression -> Lvalue AddAssignOp Expression 353Calculated and pushed value: 42 354Popping 3 values to evaluate R1:3@0-9C2@2, rule: 1: Expression -> Lvalue AssignOp Expression 355Calculated and pushed value: 42 356Popping 1 values to evaluate R0:1@0-9C1@0, rule: 0: Statement -> Expression 357Calculated and pushed value: 'a=42 b=42 c=-5 d=6 e=3' 358New Virtual Rule: R7:1@0-9C0@0, rule: 7: Statement['] -> Statement 359Real symbol count is 1 360END_TRACE_OUTPUT 361 362Marpa::PP::Test::is( $trace_output, $expected_trace_output, 363 'Leo Example Trace Output' ); 364 3651; # In case used as "do" file 366 367# Local Variables: 368# mode: cperl 369# cperl-indent-level: 4 370# fill-column: 100 371# End: 372# vim: expandtab shiftwidth=4: 373