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

[tcurtis at svn.parrot.org]

Author: tcurtis
Date: Fri Jun  4 20:45:37 2010
New Revision: 47357
URL: https://trac.parrot.org/parrot/changeset/47357

Log:
Smart matching on PAST::Pattern, regex, and sub children tested and working.

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

Modified: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp	Fri Jun  4 19:28:12 2010	(r47356)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp	Fri Jun  4 20:45:37 2010	(r47357)
@@ -69,7 +69,10 @@
         my $result := 0;
         if (pir::can__IPs($patt, "ACCEPTS")) {
             $result := $val ~~ $patt;
-        } else {
+        } elsif (pir::does($patt, "invokable")) {
+            $result := ?$patt($val);
+        }
+        else {
             $result := pir::iseq__IPP($patt, $val);
             CATCH {
                 $result := 0;

Modified: branches/gsoc_past_optimization/t/library/pastpattern.t
==============================================================================
--- branches/gsoc_past_optimization/t/library/pastpattern.t	Fri Jun  4 19:28:12 2010	(r47356)
+++ branches/gsoc_past_optimization/t/library/pastpattern.t	Fri Jun  4 20:45:37 2010	(r47357)
@@ -5,7 +5,7 @@
 pir::load_bytecode('PCT.pbc');
 pir::load_bytecode('PAST/Pattern.pbc');
 
-plan(803);
+plan(875);
 
 test_type_matching();
 test_attribute_exact_matching();
@@ -341,16 +341,45 @@
         right($class.new(PAST::Val.new()), $pattern,
               "Single PAST::Pattern child");
         wrong($class.new(), $pattern,
-              "Single PAST::Pattern, no corresponding child.");
+              "Single PAST::Pattern, no corresponding child");
         wrong($class.new(PAST::Block.new()), $pattern,
-              "Single PAST::Pattern, wrong node type.");
+              "Single PAST::Pattern, wrong node type");
         wrong($class.new(PAST::Val.new(), PAST::Val.new()), $pattern,
-              "Single PAST::Pattern, extra child of right type.");
+              "Single PAST::Pattern, extra child of right type");
         wrong($class.new(PAST::Val.new(), PAST::Block.new()), $pattern,
-              "Single PAST::Pattern, extra child of wrong type.");
+              "Single PAST::Pattern, extra child of wrong type");
         wrong($class.new(PAST::Block.new(), PAST::Val.new()), $pattern,
-              "Single PAST::Pattern, extra child of wrong type first.");
+              "Single PAST::Pattern, extra child of wrong type first");
+
+        $pattern := $patternClass.new(/foo/);
+
+        right($class.new("foo"), $pattern,
+              "Single regex");
+        wrong($class.new(), $pattern,
+              "Single regex, no corresponding child");
+        wrong($class.new("fop"), $pattern,
+              "Single regex, wrong string");
+        wrong($class.new("foo", "foo"), $pattern,
+              "Single regex, extra child of right string");
+        wrong($class.new("foo", "bar"), $pattern,
+              "Single regex, extra child of wrong string");
+        wrong($class.new("bar", "foo"), $pattern,
+              "Single regex, extra child of wrong string first.");
         
+        $pattern := $patternClass.new(sub ($_) { +$_ % 2; });
+
+        right($class.new(3), $pattern,
+              "Single closure child");
+        wrong($class.new(), $pattern,
+              "Single closure, no corresponding child");
+        wrong($class.new(2), $pattern,
+              "Single closure, false result");
+        wrong($class.new(3, 5), $pattern,
+              "Single closure, extra child of right result");
+        wrong($class.new(3, 6), $pattern,
+              "Single closure, extra child of wrong result");
+        wrong($class.new(6, 3), $pattern,
+              "Single closure, extra child of wrong result first");
     }
 }