Changeset 21811 for perl5

Timestamp:

08/06/08 17:08:07 (4 months ago)

Author:

fglock

Message:

[PCR] single-step in alternations

Location:

perl5/Pugs-Compiler-Rule

Files:

• lib/Pugs/Runtime/Regex.pm (modified) (3 diffs)
• t/01-iterator_engine_step.t (modified) (3 diffs)

perl5/Pugs-Compiler-Rule/lib/Pugs/Runtime/Regex.pm

@@ -17 +17 @@
     my $nodes = shift;
     return sub {
+        my $single_step = $_[2]{single_step};
         my @state = $_[1] ? @{$_[1]} : ( 0, undef );
         while ( $state[0] <= $#$nodes ) {
@@ -24 +25 @@
             $state[1] = $_[3]->state;
             $state[0]++ unless $state[1];
-            if ( $_[3] || $_[3]->data->{abort} ) {
+            if ( $_[3] || $_[3]->data->{abort} || $single_step ) {
                 $_[3]->data->{state} = $state[0] > $#$nodes 
                     ? undef
@@ -47 +48 @@
     }
     return sub {
+        my $single_step = $_[2]{single_step};
         my @state = $_[1] ? @{$_[1]} : ( undef, undef );
         #print "enter state ",Dumper(\@state);

perl5/Pugs-Compiler-Rule/t/01-iterator_engine_step.t

@@ -4 +4 @@
 use warnings;
 
-use Test::More tests => 58;
+use Test::More tests => 53;
 # use Data::Dumper;
 # $Data::Dumper::Indent = 1;
@@ -16 +16 @@
 {
   $rule = Pugs::Runtime::Regex::constant( 'a' );
-  $rule->( 'a123', undef, {capture=>1, step=>1}, $match );
+  $rule->( 'a123', undef, {capture=>1, single_step=>1}, $match );
   #print Dumper( $match );
   ok ( $match->bool, "a =~ /a/ #1" );
@@ -29 +29 @@
 
 {
-  $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( 'x' ), 
         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 );
+  $rule->( 'ab', undef, {single_step => 1}, $match );
+  #print "state: ", Dumper($match->state), "\n";
+  is ( $match->str, '', "/[a|ab]/ multi-match continuation state #0 - no match" );
+  $rule->( 'ab', $match->state, {single_step => 1}, $match );
+  #print "state: ", Dumper($match->state), "\n";
+  is ( $match->str, 'a', "/[a|ab]/ multi-match continuation state #1" );
+  $rule->( 'ab', $match->state, {single_step => 1}, $match );
+  #print "state: ", Dumper($match->state), "\n";
+  is ( $match->str, 'ab', "/[a|ab]/ multi-match continuation state #2" );
+  #$rule->( 'ab', $match->state, {single_step => 1}, $match );
   #print "state: ", Dumper($match->state), "\n";
   #is ( $match->str, '', "/[a|ab]/ multi-match state #2" );