view release on metacpan or  search on metacpan

perl5/Pugs-Compiler-Rule/t/09-ratchet.t  view on Meta::CPAN

    is( $match->[0], "c", "alternative - 3" );
    is( $match->[2], "d", "alternative - 4" );
}

{
    my $rule = Pugs::Compiler::Token->compile( 'ab|ac' );
    #print "Source: ", do{use Data::Dumper; Dumper($rule->{perl5})};
    my $match = $rule->match("ac");
    #print "Match: ", do{use Data::Dumper; Dumper($match)};
    ok( $match, "alternation no backtracking" );
}

{
    # named rules are methods
    *test::rule_method = Pugs::Compiler::Token->compile( '((.).)(.)' )->code;
    #print "Source: ", do{use Data::Dumper; Dumper(Pugs::Compiler::Rule->compile( '((.).)(.)', { ratchet => 1 } )->{perl5})};
    my $match = test->rule_method( "xyzw" );
    #print "Match: ", do{use Data::Dumper; Dumper($match)};
    is( "$match", "xyz", 'named rules are methods' );
}

{
    # calling named subrules
    *test::rule_method3 = Pugs::Compiler::Token->compile( '.' )->code;
    *test::rule_method4 = Pugs::Compiler::Token->compile( '<rule_method3>' )->code;
    #print "Source: ", do{use Data::Dumper; Dumper(Pugs::Compiler::Token->compile( '<rule_method3>' )->{perl5})};
    my $match = test->rule_method4( "xyzw" );
    #print "Match: ", do{use Data::Dumper; Dumper($match)};
    is( "$match", "x", 'a named subrule calls a named subrule in same grammar' );
}

{
    # calling named subrules in other grammars
    *test2::rule_method = Pugs::Compiler::Token->compile( '.', { ratchet => 1 } )->code;
    *test::rule_method5 = Pugs::Compiler::Token->compile( '<test2.rule_method>', { ratchet => 1 } )->code;
    my $match = test->rule_method5( "xyzw" );
    #print "Source: ", do{use Data::Dumper; Dumper($rule->{perl5})};
    #print "Match: ", do{use Data::Dumper; Dumper($match)};
    is( "$match", "x", 'a named subrule calls a named subrule in other grammar' );
}

{
    # calling unnamed subrules
    $test2::rule2 = Pugs::Compiler::Rule->compile( '.' );
    *test::rule_method2 = Pugs::Compiler::Token->compile( '<$test2::rule2>', { ratchet => 1 } )->code;
    my $match = test->rule_method2( "xyzw" );
    #print "Source: ", do{use Data::Dumper; Dumper($rule->{perl5})};
    #print "Match: ", do{use Data::Dumper; Dumper($match)};
    is( "$match", "x", 'a named subrule calls a global unnamed subrule' );
}

{
    # calling unnamed subrules
    my $match;
    my $rule2 = Pugs::Compiler::Token->compile( '.', { ratchet => 1 } );
    #print "Source: ", do{use Data::Dumper; Dumper( $rule2->perl5 )};
    eval {
    *test::rule_method6 = Pugs::Compiler::Token->compile( '<$rule2>', { ratchet => 1 } )->code;
    $match = test->rule_method6( "xyzw" );
    };
    warn "# *** Please check if CPAN module 'PadWalker' is properly installed\n",
         "# *** This is the resulting error: $@"
        if $@;
    #print "Source: ", do{use Data::Dumper; Dumper( Pugs::Compiler::Token->compile( '<$rule2>', { ratchet => 1 } )->perl5 )};
    #print "Match: ", do{use Data::Dumper; Dumper($match)};
    is( "$match", "x", 'a named subrule calls a lexical unnamed subrule' );
}

{
    # generated rules
    my $rule = Pugs::Compiler::Token->compile( '<alpha>+', { ratchet => 1 } );
    my $match = $rule->match( "xy12" );
    #print "Source: ", do{use Data::Dumper; Dumper( $rule->perl5 ) };
    #print "Match: ", do{use Data::Dumper; Dumper($match)};
    is( "$match", "xy", 'built-in rule <alpha>' );
    is( join( ' ', $match->keys ), "alpha", 'keys() method' );
    # is( join( ' ', $match->kv ), "alpha xy", 'kv() method' );
}

{
    # not-special chars
    my $rule = Pugs::Compiler::Token->compile( ',', { ratchet => 1 } );
    #print "Source: ", do{use Data::Dumper; Dumper( $rule->perl5 )};
    my $match = $rule->match( "," );
    is( "$match", ",", 'comma is not a special char' );
}

{
    # escaped chars
    my $rule = Pugs::Compiler::Token->compile( '\(', { ratchet => 1 } );
    #print "Source: ", do{use Data::Dumper; Dumper($rule->perl5)};
    my $match = $rule->match( "(xy12)" );
    #print "Match: ", do{use Data::Dumper; Dumper($match)};
    is( "$match", "(", 'escaped char' );
}

{
    # escaped chars
    my $rule = Pugs::Compiler::Token->compile( '\n', { ratchet => 1 } );
    my $match = $rule->match( "\nxy12" );
    is( "$match", "\n", 'escaped char \\n' );
}

#TODO: 
{
    #local $TODO = "usage of :!p in token is not specified";
    # escaped chars
    my $rule = Pugs::Compiler::Token->compile( '\d', { ratchet => 1 } );
    my $match = $rule->match( "abc123" );
    #print "Source: ", do{use Data::Dumper; Dumper($rule->perl5)};
    #print "Match: ", do{use Data::Dumper; Dumper($match)};
    is( "$match", "1", 'escaped char \\d' );
}

#TODO: 
{
    #local $TODO = "usage of :!p in token is not specified";
    # escaped chars
    my $rule = Pugs::Compiler::Token->compile( '\D', { ratchet => 1 } );
    my $match = $rule->match( "123abc" );
    is( "$match", "a", 'escaped char \\D' );