use Test::More tests => 43;
use Data::Dumper;
$Data::Dumper::Indent = 1;
use strict;
use warnings;
no warnings 'once';
use_ok( 'Pugs::Compiler::Regex' );
use base 'Pugs::Grammar::Base';
{
my $rule = Pugs::Compiler::Regex->compile('\w');
my $rule2 = eval $rule->perl5;
warn $@ if $@;
is( ref($rule2), 'Pugs::Compiler::Regex', "a Regex object");
my $match = $rule2->match("abc");
is( "$match",'a',"perl5 returns eval'able code");
}
{
local *rule = Pugs::Compiler::Regex->compile('<ws>')->code();
#print "rule: ", Pugs::Compiler::Regex->compile('<ws>')->{perl5};
my $match;
TODO: {
local $TODO = "weird <ws> rule matches 'null' before the text";
$match = __PACKAGE__->rule("abc");
#print "match: ", Dumper( $match->data );
is( $match ? 1 : 0 , 0 ,"no ws");
}
$match = __PACKAGE__->rule(" abc", { pos => 0 } );
#print "match: ", Dumper( $match->data );
is( $match ? 1 : 0 , 1 ,"Matched <ws> at pos=0");
$match = __PACKAGE__->rule("ab c");
is( $match ? 1 : 0 , 1 ,"Matched non-anchored <ws>");
}
{
local *Test123::rule1 = Pugs::Compiler::Regex->compile('\w')->code();
local *Test123::rule2 = Pugs::Compiler::Regex->compile('(<rule1>)*')->code();
#print "rule: ", Pugs::Compiler::Regex->compile('(<rule1>)*')->perl;
my $match = Test123->rule2("abc");
#print Dumper( $$match );
is($match,'abc',"Matched...");
is( $match->[0][0],"a","Capture 1...");
is( $match->[0][1],"b","Capture 2...");
is( $match->[0][2],"c","Capture 3...");
is( $match->[0][3],undef,"No more captures");
is( $match->[1],undef,"No more captures");
}
{
local *Test123::rule1 = Pugs::Compiler::Regex->compile('\w')->code();
local *Test123::rule2 = Pugs::Compiler::Regex->compile('<rule1>*')->code();
#print "rule: ", Pugs::Compiler::Regex->compile('<rule1>*')->perl;
my $match = Test123->rule2("abc");
#print "match: ", $match->perl;
is($match,'abc',"Matched...");
is(ref($match->{rule1}),"ARRAY",'$<rule1> is an array...');
is( $match->{rule1}[0],"a","Capture 1...");
is( $match->{rule1}[1],"b","Capture 2...");
is( $match->{rule1}[2],"c","Capture 3...");
is( $match->{rule1}[3],undef,"No more captures");
}
{
local *Test123::rule1 = Pugs::Compiler::Regex->compile('\w')->code();
local *Test123::rule2 = Pugs::Compiler::Regex->compile('<rule1><rule1>')->code();
my $match = Test123->rule2("abc");
is($match,'ab',"Matched...");
is(ref($match->{rule1}),"ARRAY",'$<rule1> is an array...');
is( $match->{rule1}[0],"a","Capture 1...");
is( $match->{rule1}[1],"b","Capture 2...");
is( $match->{rule1}[3],undef,"No more captures");
}
#SKIP:
{
#skip "infinite loop - backtracking into subrules", 5;
# backtracking into subrules
my $rule1 = Pugs::Compiler::Regex->compile('(\w)+');
my $rule2 = Pugs::Compiler::Regex->compile('a<$rule1>z');
#print $rule1->perl5;
#print $rule2->perl5;
#print Pugs::Compiler::Regex->compile('a<rule1>z')->perl5;
my $match = $rule2->match("abcz");
is( "$match",'abcz',"backtracking subrule matched");
#print map { ref($_) ? Dumper($_->data) : Dumper($_) } @{$match->[0]};
is(ref($match->[0]),"ARRAY",'array...');
is( $match->[0][0],"b","Capture 1...");
is( $match->[0][1],"c","Capture 2...");
is( $match->{rule1}[0][3],undef,"No more captures");
}
{
# before
my $rule = Pugs::Compiler::Regex->compile('(a)<before z>');
#print $rule->perl5;
my $match = $rule->match("az");
is( "$match",'a',"before matched");
no warnings qw( uninitialized );
$match = $rule->match("a");
#print Dumper( $match->data );
is( "$match",'',"before didn't match");
$match = $rule->match("ab");
is( "$match",'',"before didn't match");
}
{
# <$rule>
$Test::z = Pugs::Compiler::Regex->compile('z');
my $rule = Pugs::Compiler::Regex->compile('(a)<before <$Test::z>>');
#print $rule->perl5;
my $match = $rule->match("az");
is( "$match",'a',"<\$var> matched");
no warnings qw( uninitialized );
$match = $rule->match("a");
#print Dumper( $match->data );
is( "$match",'',"<\$var> didn't match");
$match = $rule->match("ab");
is( "$match",'',"<\$var> didn't match");
}
SKIP:
{
skip "named parameters don't parse correctly", 1;
my $subrule = Pugs::Compiler::Regex->compile(' .* $^a{to} ');
#print $subrule->perl5;
{
package Test;
use base 'Pugs::Grammar::Base';
*subrule = $subrule->code;
}
my $rule = Pugs::Compiler::Regex->compile(' \[ <Test.subrule(to=>"]")> ');
my $match = $rule->match("[abc]");
#print Dumper $match;
#print $match->(), "\n";
is( "$match",'[abc]',"subrule+param matched");
}
SKIP: {
skip "failing optional quantifier - subrule + param", 1;
my $subrule = Pugs::Compiler::Regex->compile(' .*? $^a ');
#print $subrule->perl5;
{
package Test;
use base 'Pugs::Grammar::Base';
*subrule2 = $subrule->code;
}
my $rule = Pugs::Compiler::Regex->compile(' \[ <Test.subrule2("]")> ');
my $match = $rule->match("[abc]");
#print Dumper $match;
#print $match->(), "\n";
is( "$match",'[abc]',"subrule+param matched");
}
{
# from pugs capture.t
{
package Test123;
use base 'Pugs::Grammar::Base';
*dotdot = Pugs::Compiler::Regex->compile('(.)(.)')->code();
*rule2 = Pugs::Compiler::Regex->compile('(a.)<.dotdot>(..)')->code();
# my $dbg = Pugs::Compiler::Regex->compile('(a.)<.dotdot>(..)');
# print $dbg->perl5;
}
my $match = Test123->rule2("zzzabcdefzzz");
#print Dumper $match;
is($match,'abcdef',"Captured");
is( $match->[0],"ab","Capture 0...");
is( $match->[1],"ef","Capture 1...");
is( $match->[2],undef,"No more captures");
}
{
# from pugs capture.t
my $rule = Pugs::Compiler::Regex->compile('(a)($0)');
#print $rule->perl5;
my $match = $rule->match("zzzaazzz");
is($match,'aa',"Captured");
is( $match->[0],"a","Capture 0...");
is( $match->[1],"a","Capture 1...");
}