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

[tcurtis at svn.parrot.org]

Author: tcurtis
Date: Thu Jun  3 00:55:19 2010
New Revision: 47317
URL: https://trac.parrot.org/parrot/changeset/47317

Log:
All PAST::Node and PCT::Node "attributes" exact match tests pass.

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	Wed Jun  2 23:02:51 2010	(r47316)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern.nqp	Thu Jun  3 00:55:19 2010	(r47317)
@@ -82,7 +82,14 @@
     }
 
     sub check_node_attributes ($pattern, $node) {
-        check_attribute($pattern, $node, "name");
+        (check_attribute($pattern, $node, "name")
+         && check_attribute($pattern, $node, "source")
+         && check_attribute($pattern, $node, "pos")
+         && check_attribute($pattern, $node, "returns")
+         && check_attribute($pattern, $node, "arity")
+         && check_attribute($pattern, $node, "named")
+         && check_attribute($pattern, $node, "flat")
+         && check_attribute($pattern, $node, "lvalue"));
     }
 
     method ACCEPTS ($node) {

Modified: branches/gsoc_past_optimization/t/library/pastpattern.t
==============================================================================
--- branches/gsoc_past_optimization/t/library/pastpattern.t	Wed Jun  2 23:02:51 2010	(r47316)
+++ branches/gsoc_past_optimization/t/library/pastpattern.t	Thu Jun  3 00:55:19 2010	(r47317)
@@ -5,7 +5,7 @@
 pir::load_bytecode('PCT.pbc');
 pir::load_bytecode('PAST/Pattern.pbc');
 
-plan(96);
+plan(501);
 
 test_type_matching();
 test_attribute_exact_matching();
@@ -81,6 +81,13 @@
 
 sub test_attribute_exact_matching () {
     test_attribute_exact_matching_on_node_attr("name");
+    test_attribute_exact_matching_on_node_attr("source");
+    test_attribute_exact_matching_on_node_attr("pos");
+    test_attribute_exact_matching_on_node_attr("returns");
+    test_attribute_exact_matching_on_node_attr("arity");
+    test_attribute_exact_matching_on_node_attr("named");
+    test_attribute_exact_matching_on_node_attr("flat");
+    test_attribute_exact_matching_on_node_attr("lvalue");
 }
 
 sub node_with_attr_set ($class, $attr, $val) {
@@ -95,12 +102,20 @@
 }
 
 sub test_attribute_exact_matching_on_node_attr($attr) {
-    my @classes := [ [PAST::Pattern::Block, PAST::Block],
-                     [PAST::Pattern::Op, PAST::Op],
-                     [PAST::Pattern::Stmts, PAST::Stmts],
-                     [PAST::Pattern::Val, PAST::Val],
-                     [PAST::Pattern::Var, PAST::Var],
-                     [PAST::Pattern::VarList, PAST::VarList] ];
+    my @classes :=
+      $attr eq "lvalue" ??
+        [ [PAST::Pattern::Block, PAST::Block],
+          [PAST::Pattern::Op, PAST::Op],
+          [PAST::Pattern::Stmts, PAST::Stmts],
+          [PAST::Pattern::Var, PAST::Var],
+          [PAST::Pattern::VarList, PAST::VarList] ]
+        !!
+          [ [PAST::Pattern::Block, PAST::Block],
+            [PAST::Pattern::Op, PAST::Op],
+            [PAST::Pattern::Stmts, PAST::Stmts],
+            [PAST::Pattern::Val, PAST::Val],
+            [PAST::Pattern::Var, PAST::Var],
+            [PAST::Pattern::VarList, PAST::VarList] ];
 
     for @classes {
         my $class := $_[1];