# pX/Common/p6rule.t - fglock

use strict;
use warnings;

use Test::More tests => 58;
# use Data::Dumper;
# $Data::Dumper::Indent = 1;
# $Data::Dumper::Pad = '# ';

use_ok( 'Pugs::Runtime::Regex' );
use Pugs::Runtime::Match;

my ( $rule, $match );

{
  $rule = Pugs::Runtime::Regex::constant( 'a' );
  $rule->( 'a123', undef, {capture=>1}, $match );
  #print Dumper( $match );
  ok ( $match->bool, "a =~ /a/ #1" );
  is ( $match->tail, '123', "tail is ok" );
  $rule->( 'c', undef, {capture=>1}, $match );
  ok ( ! $match->bool, "c =~ /a/ #2" );
  #is ( $match->tail, 'c123', "tail is ok" );
  #print Dumper( $match );
  $rule->( 'ca', undef, {}, $match);
  ok( !$match->bool, "anchored match" );
}

{
  $rule = 
    Pugs::Runtime::Regex::non_greedy_plus( 
      Pugs::Runtime::Regex::alternation( [
        Pugs::Runtime::Regex::constant( 'a' ), 
        Pugs::Runtime::Regex::constant( 'c' ), 
      ] ),
    );
  $rule->( 'a123', undef, {capture=>1}, $match );
  ok ( $match->bool, "/[a|c]+?/ #1" );
  is ( $match->tail, '123', "tail is ok" );
  $rule->( 'c123', undef, {capture=>1}, $match );
  ok ( $match->bool, "/[a|c]+?/ #2" );
  is ( $match->tail, '123', "tail is ok" );
  #print Dumper( $match );
  $rule->( 'aa123', undef, {capture=>1}, $match );
  ok ( $match->bool, "/[a|c]+?/ #3" );
  is ( $match->tail, 'a123', "tail is ok" );
}

{
  # -- continuations in alternation()
  $rule = 
      Pugs::Runtime::Regex::alternation( [
        Pugs::Runtime::Regex::constant( 'a' ), 
        Pugs::Runtime::Regex::constant( 'ab' ), 
      ] );
  $rule->( 'ab', undef, {}, $match );
  #print "state: ", Dumper($match->state), "\n";
  is ( $match->str, 'a', "/[a|ab]/ multi-match continuation state #0" );
  $rule->( 'ab', $match->state, {}, $match );
  #print "state: ", Dumper($match->state), "\n";
  is ( $match->str, 'ab', "/[a|ab]/ multi-match continuation state #1" );
  #$rule->( 'ab', $match->state, {}, $match );
  #print "state: ", Dumper($match->state), "\n";
  #is ( $match->str, '', "/[a|ab]/ multi-match state #2" );
  #print Dumper( $match );
}

{
  # -- continuations in concat()
  $rule = 
    Pugs::Runtime::Regex::concat( [
      Pugs::Runtime::Regex::alternation( [
        Pugs::Runtime::Regex::constant( 'a' ), 
        Pugs::Runtime::Regex::constant( 'ab' ), 
      ] ),
      Pugs::Runtime::Regex::alternation( [
        Pugs::Runtime::Regex::constant( 'b' ), 
        Pugs::Runtime::Regex::constant( 'bb' ), 
      ] ),
    ] );
  my $str = 'abbb';
  $rule->( $str, undef, {}, $match );
  #print "state 1: ", Dumper($match->state), "\n";
  is ( $match->str, 'ab', "/[a|ab][b|bb]/ continuation state #0" );

  $rule->( $str, $match->state, {}, $match );
  #print "state 2: ", Dumper($match->state), "\n";
  is ( $match->str, 'abb', "state #1" );

  $rule->( $str, $match->state, {}, $match );
  #print "state 3: ", Dumper($match->state), "\n";
  is ( $match->str, 'abb', "state #2" );

  $rule->( $str, $match->state, {}, $match );
  #print "state 4: ", Dumper($match->state), "\n";
  is ( $match->str, 'abbb', "state #3" );

}

{
  $rule = 
    Pugs::Runtime::Regex::greedy_star( 
      Pugs::Runtime::Regex::constant( 'a' ) 
    );
  is ( ref $rule, "CODE", "rule 'a*' is a coderef" );
  $rule->( 'aa', undef, {}, $match );
  #print Dumper( $match );
  ok ( $match->bool, "/a*/" );
  #print Dumper( $match );
  is ( $match->str, 'aa' );
  $rule->( 'aaaaab', undef, {}, $match );
  ok ($match->bool, "/a*/" );
  is ($match->str, 'aaaaa');
  $rule->( '', undef, {}, $match );
  ok ( $match->bool, "matches 0 occurrences" );
  #print Dumper( $match );
}

{
  $rule = 
    Pugs::Runtime::Regex::greedy_plus( 
      Pugs::Runtime::Regex::constant( 'a' ) 
    );
  $rule->( 'aa', undef, {}, $match );
  ok ( $match->bool, "/a+/" );
  is ( $match->str, 'aa' );
  $rule->( '!!', undef, {}, $match );
  ok ( ! $match->bool, "rejects unmatching text" );
}

{
  $rule = 
    Pugs::Runtime::Regex::greedy_plus( 
      Pugs::Runtime::Regex::constant( 'a' ),
      3, 
    );
  $rule->( 'aaaa', undef, {}, $match );
  is ( "$match", "aaaa", "/a**{3..*}/" );
  $rule->( 'aaa', undef, {}, $match );
  is ( "$match", "aaa", "/a**{3..*}/" );
  $rule->( 'aa', undef, {}, $match );
  ok ( ! $match->bool, "rejects unmatching text" );
}

{
  $rule = 
    Pugs::Runtime::Regex::concat( 
      Pugs::Runtime::Regex::greedy_plus( 
        Pugs::Runtime::Regex::alternation( [
          Pugs::Runtime::Regex::constant( 'a' ), 
          Pugs::Runtime::Regex::constant( 'c' ), 
        ] ),
      ),
      Pugs::Runtime::Regex::constant( 'ab' )
     );
  $rule->( 'aacaab', undef, {}, $match );
  ok ( $match->bool, "/[a|c]+ab/ with backtracking" );
  is ( $match->str, 'aacaab', 'all the chars accepted' );
  # print Dumper( $match );
}

{
  $rule = 
    Pugs::Runtime::Regex::non_greedy_plus( 
      Pugs::Runtime::Regex::alternation( [
        Pugs::Runtime::Regex::constant( 'a' ), 
        Pugs::Runtime::Regex::constant( 'c' ), 
      ] ),
    );
  $rule->( 'aacaab', undef, {capture=>1}, $match );
  ok ( $match, "/[a|c]+?/" );
  is ( $match->tail, 'acaab', "tail is ok" );
  #print Dumper( $match );
  $rule->( 'cacab', undef, {}, $match );
  ok $match->bool;
  is $match->str, 'c';
}

{
  $rule = 
    Pugs::Runtime::Regex::concat(
      Pugs::Runtime::Regex::non_greedy_plus( 
        Pugs::Runtime::Regex::alternation( [
          Pugs::Runtime::Regex::constant( 'a' ), 
          Pugs::Runtime::Regex::constant( 'c' ), 
        ] ),
      ),
      Pugs::Runtime::Regex::constant( 'cb' )
    );
  $rule->( 'aacacb', undef, {capture=>1}, $match );
  ok ( defined $match, "/[a|c]+?cb/ with backtracking" );
  #print Dumper( $match );
  is $match->str, 'aacacb';
  is $match->tail, '';
}

{
  # tests for a problem found in the '|' implementation in p6rule parser
  
  my $rule = 
    Pugs::Runtime::Regex::constant( 'a' );
  my $alt = 
    Pugs::Runtime::Regex::concat(
        $rule,
        Pugs::Runtime::Regex::optional (
            Pugs::Runtime::Regex::concat(
                Pugs::Runtime::Regex::constant( '|' ),
                $rule
            )
        )
    );
  $alt->( 'a', undef, {capture=>1}, $match );
  ok ( defined $match, "/a[\|a]?/ #1" );
  is $match->str, 'a';
  $alt->( 'a|a', undef, {capture=>1}, $match );
  ok ( defined $match, "/a[\|a]?/ #2" );
  is $match->str, 'a|a';
  $alt->( 'a|a|a', undef, {capture=>1}, $match );
  ok ( defined $match, "/a[\|a]?/ #3" );
  is $match->str, 'a|a';

  # adding '*' caused a deep recursion error (fixed)

  $alt = 
    Pugs::Runtime::Regex::concat(
        $rule,
        Pugs::Runtime::Regex::greedy_star(
          Pugs::Runtime::Regex::concat(
              Pugs::Runtime::Regex::constant( '|' ),
              $rule
          )
        )
    );
  $alt->( 'a', undef, {capture=>1}, $match );
  ok ( $match, "/a[\|a]*/ #1" );
  is $match->str, 'a';
  $alt->( 'a|a', undef, {capture=>1}, $match );
  ok ( $match, "/a[\|a]*/ #2" );
  is $match->str, 'a|a';
  $alt->( 'a|a|a', undef, {capture=>1}, $match );
  ok ( $match, "/a[\|a]*/ #3" );
  is $match->str, 'a|a|a';
}

{
    # ranges

  $rule = 
    Pugs::Runtime::Regex::concat(
      Pugs::Runtime::Regex::non_greedy_plus( 
        Pugs::Runtime::Regex::alternation( [
          Pugs::Runtime::Regex::constant( 'a' ), 
          Pugs::Runtime::Regex::constant( 'c' ), 
        ] ),
        2, 4,  # range
      ),
      Pugs::Runtime::Regex::constant( 'cb' )
    );
  $rule->( 'aacacb', undef, {capture=>1}, $match );
  ok ( defined $match, "/[a|c]**{2..4}?cb/ with backtracking" );
  #print Dumper( $match );
  #print "Match: $match \n"; # 
  is ( "$match", "aacacb", "/[a|c]**{2..4}?cb/ with range" );
  $rule->( 'aacb', undef, {}, $match);
  is "$match", "aacb", 'a**{2..2}cb';
  $rule->( 'cccb', undef, {}, $match);
  is "$match", 'cccb', 'c**{2..2}cb';
  $rule->( 'caacb', undef, {}, $match);
  is "$match", 'caacb', '[a|c]**{3..3}cb';

  $rule = 
    Pugs::Runtime::Regex::concat(
      Pugs::Runtime::Regex::non_greedy_plus( 
        Pugs::Runtime::Regex::alternation( [
          Pugs::Runtime::Regex::constant( 'a' ), 
          Pugs::Runtime::Regex::constant( 'c' ), 
        ] ),
        1, 2,  # range
      ),
      Pugs::Runtime::Regex::constant( 'cb' )
    );
  $rule->( 'aacacb', undef, {capture=>1}, $match );
  ok ( $match ? 0 : 1, "/[a|c]**{1..2}?cb/ with bad range fails" );

  $rule = 
    Pugs::Runtime::Regex::concat(
      Pugs::Runtime::Regex::non_greedy_plus( 
        Pugs::Runtime::Regex::alternation( [
          Pugs::Runtime::Regex::constant( 'a' ), 
          Pugs::Runtime::Regex::constant( 'c' ), 
        ] ),
        5, 7,  # range
      ),
      Pugs::Runtime::Regex::constant( 'cb' )
    );
  $rule->( 'aacacb', undef, {capture=>1}, $match );
  ok ( $match ? 0 : 1, "/[a|c]**{5..7}?cb/ with bad range fails" );
}

{
  # -- concat() empty array
  $rule = 
    Pugs::Runtime::Regex::concat( [] );
  my $str = 'abbb';
  $rule->( $str, undef, {}, $match );
  #print "state 1: ", Dumper($match->state), "\n";
  is ( $match->str, '', "empty concat" );
}