The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

use Test::More tests => 50;
use Data::Dumper;

use_ok( 'Pugs::Compiler::Regex' );
use_ok( 'Pugs::Grammar::Base' );

{
    my $rule = Pugs::Compiler::Regex->compile( '<null>' );
    #print $rule->{perl5};
    my $match = $rule->match( "" );
    #print "match: ", $match->perl;
    is( $match ? 1 : 0, 1, 'boolean true' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '.' );
    #print $rule->{perl5};
    my $match = $rule->match( "xyzw" );
    #print "match: ", $match->perl;
    is( "$match", "x", 'stringify 1' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '.|.' );
    #print $rule->{perl5};
    my $match = $rule->match( "xyzw" );
    #print "match: ", $match->perl;
    is( "$match", "x", 'stringify 2' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '.*' );
    my $match = $rule->match( "xyzw" );
    is( "$match", "xyzw", 'stringify 4' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '.|.|.' );
    my $match = $rule->match( "xyzw" );
    is( "$match", "x", 'stringify 5' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '..|..' );
    my $match = $rule->match( "xyzw" );
    is( "$match", "xy", 'stringify 6' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '.:.' );
    my $match = $rule->match( "xyzw" );
    is( "$match", "xy", 'stringify 7' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '(.)' );
    my $match = $rule->match( "xyzw" );
    #print "Match: ", do{use Data::Dumper; Dumper($match->data)};
    is( "$match", "x", 'stringify 1' );
    is( $match->(), "x", 'stringify 1' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '((.).)(.)' );
    my $match = $rule->match( "xyzw" );
    #print "Match: ", do{use Data::Dumper; Dumper($match->data)};
    is( "$match", "xyz", 'stringify 1' );
    is( $match->(), "xyz", 'stringify 1' );
    is( "$match->[0]", "xy", 'stringify 2' );
    is( "$match->[0][0]", "x", 'stringify 3' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '((.).)' );
    my $match = $rule->match( "xyz" );
    is( "$match", "xy", 'stringify 1' );
    is( "$match->[0]", "xy", 'stringify 2' );
    is( "$match->[0][0]", "x", 'stringify 3' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '(.)(.)' );
    my $match = $rule->match( "abc" );
    my $ret = ['a', 'b'];
    is_deeply( [@$match], $ret, 'return match 1' );
    is( "$match", "ab", 'return match 2' );
    is( "$match->[0]", "a", 'return match 3' );
    is( "$match->[1]", "b", 'return match 4' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '..' );
    my $match = $rule->match( "xyz" );
    is( "$match", "xy", 'concat stringify' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '$<z> := (.) { return { x => { %{$_[0]} } ,} } ' );
    #print Dumper( Pugs::Grammar::Rule->rule( 'x' )->() );
    # print $rule->{perl5};
    my $match = $rule->match( "abc" );
    #print "match: ", $match->perl;
    ok( $match, 'true match' );
    my $ret = $match->();
    is( $ret->{x}{z}, "a", 'returns correct struct' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '$<z> := [.] { return { x => { %{$_[0]} } ,} } ' );
    my $match = $rule->match( "abc" );
    ok( $match, 'true match' );
    my $ret = $match->();
    is( $ret->{x}{z}, "a", 'returns correct struct' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '$<z> := <any> { return { x => { %{$_[0]} } ,} } ' );
    my $match = $rule->match( "abc" );
    ok( $match, 'true match' );
    my $ret = $match->();
    is( $ret->{x}{z}, "a", 'returns correct struct' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( '$<x> := (.)  $<y> := (.)');
    #print "Source: ", do{use Data::Dumper; Dumper($rule->{perl5})};
    my $match = $rule->match( "123" );
    #print "Match: ", do{use Data::Dumper; Dumper($match)};
    my $ret = { x => '1', y => '2' };
    is_deeply( {%$match}, $ret, 'return match' );
    is( "$match", "12", 'stringify' );
    is( "$match->{x}", "1", 'hashify' );
    is( "$match->{y}", "2", 'hashify' );
    is( 0+$match, 12, 'numify' );
}

{
    my $rule = Pugs::Compiler::Regex->compile( 'b' );
    my $match = $rule->match( "b" );
    is( $match?1:0, 1, 'boolean true');    
    is( $match->from, 0, 'match->from');
    is( $match->to, 1, 'match->to');
    $match = $rule->match( "xby" );
    is( $match?1:0, 1, 'boolean true (non-anchored match)');    
    is( $match->from, 1, 'match->from');
    is( $match->to, 2, 'match->to');
    $match = $rule->match( "x" );
    is( $match?1:0, 0, 'boolean false');    
}

# Now, try from and to on P::C::Rule instead of P::C::Regex:
use_ok( 'Pugs::Compiler::Rule' );
use_ok( 'Pugs::Runtime::Match' );
{
    my $rule = Pugs::Compiler::Rule->compile( 'b' );
    #print $rule->{perl5};
    my $match = $rule->match( "b" );
    is( $match?1:0, 1, 'boolean true');    
    is( $match->from, 0, 'match->from');
    is( $match->to, 1, 'match->to');
    $match = $rule->match( "xby" );
    is( $match?1:0, 1, 'boolean true (non-anchored match)');  
  #TODO: {  
  #  local $TODO = "non-achored match breaks from/to";
    is( $match->from, 1, 'match->from');
    is( $match->to, 2, 'match->to');
  #}
    $match = $rule->match( "x" );
    is( $match?1:0, 0, 'boolean false');    
}