[svn:parrot] r47431 - in branches/gsoc_past_optimization: runtime/parrot/library/PAST/Pattern t/library

[tcurtis at svn.parrot.org]

Author: tcurtis
Date: Sun Jun  6 22:57:45 2010
New Revision: 47431
URL: https://trac.parrot.org/parrot/changeset/47431

Log:
Matching PAST::Pattern::Constant and PAST::Pattern::Closure also return PAST::Pattern::Match objects.

Modified:
   branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Closure.nqp
   branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Constant.nqp
   branches/gsoc_past_optimization/t/library/pastpattern.t

Modified: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Closure.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Closure.nqp	Sun Jun  6 22:27:43 2010	(r47430)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Closure.nqp	Sun Jun  6 22:57:45 2010	(r47431)
@@ -19,7 +19,8 @@
     }
 
     method ACCEPTS ($node) {
-        self.code()($node);
+        PAST::Pattern::Match.new(self.code()($node),
+                                 $node);
     }
 }
 

Modified: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Constant.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Constant.nqp	Sun Jun  6 22:27:43 2010	(r47430)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Constant.nqp	Sun Jun  6 22:57:45 2010	(r47431)
@@ -18,7 +18,7 @@
     }
 
     method ACCEPTS ($node) {
-        pir::iseq__IPP(self.value(), $node);
+        PAST::Pattern::Match.new(pir::iseq__IPP(self.value(), $node));
     }
 }
 

Modified: branches/gsoc_past_optimization/t/library/pastpattern.t
==============================================================================
--- branches/gsoc_past_optimization/t/library/pastpattern.t	Sun Jun  6 22:27:43 2010	(r47430)
+++ branches/gsoc_past_optimization/t/library/pastpattern.t	Sun Jun  6 22:57:45 2010	(r47431)
@@ -5,7 +5,7 @@
 pir::load_bytecode('PCT.pbc');
 pir::load_bytecode('PAST/Pattern.pbc');
 
-plan(2024);
+plan(2033);
 
 test_type_matching();
 test_attribute_exact_matching();
@@ -546,6 +546,8 @@
 sub test_match_result () {
     test_match_result_from_top_node();
 #    test_match_result_from_sub_node();
+    test_match_result_from_closure();
+    test_match_result_from_constant();
 }
 
 sub test_match_result_from_top_node () {
@@ -567,20 +569,62 @@
         my $node := $class.new();
         my $/ := $node ~~ $pattern;
         ok($/ ~~ PAST::Pattern::Match,
-           "$begin $patternClass 1, returns a PAST::Pattern::Match");
-        ok(?$/, "$begin $patternClass 1, Bool conversion");
+           "$begin 1, returns a PAST::Pattern::Match");
+        ok(?$/, "$begin 1, Bool conversion");
         ok($/.from() =:= $node,
-           "$begin $patternClass 1, .from");
+           "$begin 1, .from");
 
         $node := ($class =:= PAST::Block
                   ?? PAST::Op !! PAST::Block).new();
         $/ := $node ~~ $pattern;
         ok($/ ~~ PAST::Pattern::Match,
-           "$begin $patternClass 0, returns PAST::Pattern::Match");
-        ok(!?$/, "$begin $patternClass 0, Bool conversion.");
+           "$begin 0, returns PAST::Pattern::Match");
+        ok(!?$/, "$begin 0, Bool conversion.");
     }
 }
 
+sub test_match_result_from_closure () {
+    my $pattern := 
+      PAST::Pattern::Closure.new(sub ($_) { 
+                                     $_ ~~ PAST::Val
+                                       && $_.returns() eq 'Integer';
+                                 });
+    my $node := PAST::Val.new(:returns('Integer'));
+    my $/ := $node ~~ $pattern;
+    
+    ok($/ ~~ PAST::Pattern::Match, 
+       "Match result from Closure 1 is a PAST::Pattern::Match.");
+    ok(?$/,
+       "Match result from Closure 1 converts to boolean truth.");
+    ok($/.from =:= $node,
+       "Match result from Closure 1 has correct .from.");
+
+    $node := PAST::Val.new(:returns('String'));
+    $/ := $node ~~ $pattern;
+    ok($/ ~~ PAST::Pattern::Match,
+       "Match result from Closure 0 is a PAST::Pattern::Match.");
+    ok(!?$/,
+       "Match result from Closure 0 converts to boolean falsehood.");
+}
+
+sub test_match_result_from_constant () {
+    my $pattern := PAST::Pattern::Constant.new(5);
+    my $node := 5;
+    my $/ := $node ~~ $pattern;
+    
+    ok($/ ~~ PAST::Pattern::Match, 
+       "Match result from Constant 1 is a PAST::Pattern::Match.");
+    ok(?$/,
+       "Match result from Constant 1 converts to boolean truth.");
+
+    $node := 6;
+    $/ := $node ~~ $pattern;
+    ok($/ ~~ PAST::Pattern::Match,
+       "Match result from Constant 0 is a PAST::Pattern::Match.");
+    ok(!?$/,
+       "Match result from Constant 0 converts to boolean falsehood.");
+}
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4