Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 165 lines (141 sloc) 4.25 kb
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
use v6;

use Test;

plan 22;

# L<S05/Grammars/optionally pass an actions object>

grammar A::Test::Grammar {
    rule TOP { <a> <b> }
    token a { 'a' \w+ }
    token b { 'b' \w+ }
}

class An::Action1 {
    has $.in-a = 0;
    has $.in-b = 0;
    has $.calls = '';
    method a($/) {
        $!in-a++;
        $!calls ~= 'a';
    }
    method b($x) { #OK not used
        $!in-b++;
        $!calls ~= 'b';
    }
}

ok A::Test::Grammar.parse('alpha beta'), 'basic sanity: .parse works';
my $action = An::Action1.new();
lives_ok { A::Test::Grammar.parse('alpha beta', :actions($action)) },
        'parse with :action (and no make) lives';
is $action.in-a, 1, 'first action has been called';
is $action.in-b, 1, 'second action has been called';
is $action.calls, 'ab', '... and in the right order';

# L<S05/Bracket rationalization/"An explicit reduction using the make function">

{
    grammar Grammar::More::Test {
        rule TOP { <a> <b><c> }
        token a { \d+ }
        token b { \w+ }
        token c { '' } # no action stub
    }
    class Grammar::More::Test::Actions {
        method TOP($/) {
            make [ $<a>.ast, $<b>.ast ];
        }
        method a($/) {
            make 3 + $/;
        }
        method b($/) {
            # the given/when is pretty pointless, but rakudo
            # used to segfault on it, so test it here
            # http://rt.perl.org/rt3/Ticket/Display.html?id=64208
            given 2 {
                when * {
                    make $/ x 3;
                }
            }
        }
        method c($/) {
            #die "don't come here";
            # There's an implicit {*} at the end now
        }
    }

    # there's no reason why we can't use the actions as class methods
    my $match = Grammar::More::Test.parse('39 b', :actions(Grammar::More::Test::Actions));
    ok $match, 'grammar matches';
    isa_ok $match.ast, Array, '$/.ast is an Array';
    ok $match.ast.[0] == 42, 'make 3 + $/ worked';
    is $match.ast.[1], 'bbb', 'make $/ x 3 worked';
}

# used to be a Rakudo regression, RT #64104
{
    grammar Math {
        token TOP { ^ <value> $ }
        token value { \d+ }
    }
    class Actions {
        method value($/) { make 1..$/};
        method TOP($/) { make 1 + $/<value>};
    }
    my $match = Math.parse('234', :actions(Actions.new));
    ok $match, 'can parse with action stubs that make() regexes';
    is $match.ast, 235, 'got the right .ast';

}

# another former rakudo regression, RT #71514
{
    grammar ActionsTestGrammar {
        token TOP {
            ^ .+ $
        }
    }
    class TestActions {
        method TOP($/) {
            "a\nb".subst(/\n+/, '', :g);
            make 123;
        }
    }

    is ActionsTestGrammar.parse("ab\ncd", :actions(TestActions.new)).ast, 123,
        'Can call Str.subst in an action method without any trouble';
    # RT #78510
    isa_ok ActionsTestGrammar.parse('a', :actions(
        class { method TOP($/) { make { a => 1 } } }
    )).ast, Hash, 'Can make() a Hash';
}

# Test for a Rakudo bug revealed by 5ce8fcfe5 that (given the
# below code) set $x.ast[0] to (1, 2).
{
    grammar Grammar::Trivial {
        token TOP { a }
    };

    class Grammar::Trivial::A {
       method TOP($/) { make (1, 2) }
    };

    my $x = Grammar::Trivial.parse: 'a',
        actions => Grammar::Trivial::A.new;
    ok $x, 'Trivial grammar parsed';
    is $x.ast[0], 1, 'make(Parcel) (1)';
    is $x.ast[1], 2, 'make(Parcel) (2)';

    class MethodMake {
        method TOP($m) { $m.make('x') }
    }
    #?niecza skip 'Match.make'
    is Grammar::Trivial.parse('a', actions => MethodMake).ast,
        'x', 'can use Match.make';
}

# Scoping tests
#

my $*A;
my $*B;
my $*C;
my $*D;

# intra rule/token availability of capture variables

grammar Grammar::ScopeTests {
        rule TOP {^<a><b><c><d>$}
token a {<alpha> { $*A = ~$/ } }
token b {<alpha> { $*B = ~$<alpha> } }
token c {<alpha> <?{ $*C = ~$<alpha>; True }> }
token d {(<alpha>) { $*D = ~$0 } }
}

ok Grammar::ScopeTests.parse("wxyz"), 'scope tests parse';
is $*A, 'w', '$/ availiable';
is $*B, 'x', 'token name';
is $*C, 'y', 'token name (assertion)';
is $*D, 'z', '$0 availiable';

# vim: ft=perl6
Something went wrong with that request. Please try again.