[svn:parrot] r47474 - in branches/gsoc_past_optimization: runtime/parrot/library/PAST/Pattern t/library
tcurtis at svn.parrot.org
tcurtis at svn.parrot.org
Tue Jun 8 19:19:51 UTC 2010
Author: tcurtis
Date: Tue Jun 8 19:19:50 2010
New Revision: 47474
URL: https://trac.parrot.org/parrot/changeset/47474
Log:
Added .from() to PAST::Pattern::Constant. Added tests for matched attributes and children subpatterns($/[0], $<name>, etc.).
Modified:
branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Constant.nqp
branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Node.nqp
branches/gsoc_past_optimization/t/library/pastpattern.t
Modified: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Constant.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Constant.nqp Tue Jun 8 14:05:50 2010 (r47473)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Constant.nqp Tue Jun 8 19:19:50 2010 (r47474)
@@ -18,7 +18,8 @@
}
method ACCEPTS ($node) {
- PAST::Pattern::Match.new(pir::iseq__IPP(self.value(), $node));
+ PAST::Pattern::Match.new(pir::iseq__IPP(self.value(), $node),
+ $node);
}
}
Modified: branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Node.nqp
==============================================================================
--- branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Node.nqp Tue Jun 8 14:05:50 2010 (r47473)
+++ branches/gsoc_past_optimization/runtime/parrot/library/PAST/Pattern/Node.nqp Tue Jun 8 19:19:50 2010 (r47474)
@@ -76,8 +76,12 @@
}
my $nAttr := $node.attr($attribute, null, 0);
my $result := $nAttr ~~ $pAttr;
- $/{$attribute} := $result;
- $/.success(0) unless $result;
+ if ($result) {
+ $/{$attribute} := $result;
+ }
+ else {
+ $/.success(0);
+ }
$result;
}
@@ -119,20 +123,19 @@
method ACCEPTS ($node) {
my $result := self.ACCEPTSEXACTLY($node);
- if ($result) {
- $result := PAST::Pattern::Match.new(1, $node);
- }
- elsif ($node ~~ PAST::Node) {
- my $index := 0;
- my $max := pir::elements__IP($node);
- until ($index == $max) {
- $result := $node[$index] ~~ self;
- return $result if $result;
- $index++;
+ unless ($result) {
+ if ($node ~~ PAST::Node) {
+ my $index := 0;
+ my $max := pir::elements__IP($node);
+ until ($index == $max) {
+ $result := $node[$index] ~~ self;
+ return $result if $result;
+ $index++;
+ }
+ $result := PAST::Pattern::Match.new(0);
+ } else {
+ $result := PAST::Pattern::Match.new(0);
}
- $result := PAST::Pattern::Match.new(0);
- } else {
- $result := PAST::Pattern::Match.new(0);
}
$result;
}
@@ -228,6 +231,7 @@
"pirflags", $/)
&& PAST::Pattern::Node::check_children(self, $node, $/)
&& PAST::Pattern::Node::check_node_attributes(self, $node, $/));
+ $/.from($node) if $/;
$/;
}
}
@@ -258,6 +262,7 @@
"inline", $/)
&& PAST::Pattern::Node::check_children(self, $node, $/)
&& PAST::Pattern::Node::check_node_attributes(self, $node, $/));
+ $/.from($node) if $/;
$/;
}
}
@@ -268,6 +273,7 @@
my $/ := PAST::Pattern::Match.new(1);
(PAST::Pattern::Node::check_children(self, $node, $/)
&& PAST::Pattern::Node::check_node_attributes(self, $node, $/));
+ $/.from($node) if $/;
$/;
}
}
@@ -284,6 +290,7 @@
&& PAST::Pattern::Node::check_node_attributes(self, $node, $/)
&& PAST::Pattern::Node::check_attribute(self, $node,
"value", $/));
+ $/.from($node) if $/;
$/;
}
}
@@ -342,6 +349,7 @@
"multitype", $/)
&& PAST::Pattern::Node::check_children(self, $node, $/)
&& PAST::Pattern::Node::check_node_attributes(self, $node, $/));
+ $/.from($node) if $/;
$/;
}
}
@@ -352,6 +360,7 @@
my $/ := PAST::Pattern::Match.new(1);
(PAST::Pattern::Node::check_children(self, $node, $/)
&& PAST::Pattern::Node::check_node_attributes(self, $node, $/));
+ $/.from($node) if $/;
$/;
}
}
Modified: branches/gsoc_past_optimization/t/library/pastpattern.t
==============================================================================
--- branches/gsoc_past_optimization/t/library/pastpattern.t Tue Jun 8 14:05:50 2010 (r47473)
+++ branches/gsoc_past_optimization/t/library/pastpattern.t Tue Jun 8 19:19:50 2010 (r47474)
@@ -5,7 +5,7 @@
pir::load_bytecode('PCT.pbc');
pir::load_bytecode('PAST/Pattern.pbc');
-plan(2036);
+plan(2051);
test_type_matching();
test_attribute_exact_matching();
@@ -632,6 +632,8 @@
"Match result from Constant 1 is a PAST::Pattern::Match.");
ok(?$/,
"Match result from Constant 1 converts to boolean truth.");
+ ok($/.from() == 5,
+ "Match result from Constant 1 has correct .from.");
$node := 6;
$/ := $node ~~ $pattern;
@@ -641,6 +643,84 @@
"Match result from Constant 0 converts to boolean falsehood.");
}
+sub test_match_result_from_node_children () {
+ my $pattern := PAST::Pattern::Block.new(PAST::Pattern::Op.new(),
+ :blocktype("lexical"));
+ my $past := PAST::Block.new(PAST::Op.new(),
+ :blocktype("lexical"));
+ my $/ := $past ~~ $pattern;
+
+ ok($/<blocktype>.from() eq "lexical",
+ '$/<blocktype> is correct for PAST::Pattern::Blocks.');
+ ok($/[0].from() =:= $past[0],
+ '$/[0] is correct for PAST::Pattern::Blocks.');
+
+ $pattern :=
+ PAST::Pattern::Op.new(PAST::Pattern::Val.new(:returns<Integer>),
+ PAST::Pattern::Val.new(:returns<Integer>),
+ :pirop<add>);
+ $past := PAST::Op.new(PAST::Val.new(:returns<Integer>),
+ PAST::Val.new(:returns<Integer>),
+ :pirop<add>);
+ $/ := $past ~~ $pattern;
+
+ ok($/<pirop>.from() eq "add",
+ '$/<pirop> is correct for PAST::Pattern::Ops.');
+ ok($/[0].from() =:= $past[0],
+ '$/[0] is correct for PAST::Pattern::Ops.');
+ ok($/[1].from() =:= $past[1],
+ '$/[1] is correct for PAST::Pattern::Ops.');
+
+ $pattern := PAST::Pattern::Stmts.new(:name<foo>,
+ PAST::Pattern::Op.new());
+ $past := PAST::Stmts.new(:name<foo>,
+ PAST::Op.new());
+ $/ := $past ~~ $pattern;
+
+ ok($/<name>.from() eq "foo",
+ '$/<name> is correct for PAST::Pattern::Stmts.');
+ ok($/[0].from() =:= $past[0],
+ '$/[0] is correct for PAST::Pattern::Stmts.');
+
+ $pattern :=
+ PAST::Pattern::Val.new(:value(PAST::Pattern::Block.new()),
+ PAST::Pattern::Block.new());
+ $past := PAST::Val.new(:value(PAST::Block.new()),
+ PAST::Block.new());
+ $/ := $past ~~ $pattern;
+
+ ok($/<value>.from() =:= $past.value(),
+ '$/<value> is correct for PAST::Pattern::Vals.');
+ ok($/[0].from() =:= $past[0],
+ '$/[0] is correct for PAST::Pattern::Vals.');
+
+ $pattern :=
+ PAST::Pattern::Var.new(:name<foo>,
+ :scope<package>,
+ PAST::Pattern::Val.new());
+ $past := PAST::Var.new(:name<foo>, :scope<package>,
+ PAST::Val.new());
+ $/ := $past ~~ $pattern;
+
+ ok($/<name>.from() eq "foo",
+ '$/<name> is correct for PAST::Pattern::Vars.');
+ ok($/<scope>.from() eq "package",
+ '$/<scope> is correct for PAST::Pattern::Vars.');
+ ok($/[0].from() =:= $past[0],
+ '$/[0] is correct for PAST::Pattern::Vars.');
+
+ $pattern := PAST::Pattern::VarList.new(:name<params>,
+ PAST::Pattern::Var.new());
+ $past := PAST::VarList.new(:name<params>,
+ PAST::Var.new());
+ $/ := $past ~~ $pattern;
+
+ ok($/<name>.from() eq "params",
+ '$/<name> is correct for PAST::Pattern::VarList.');
+ ok($/[0].from() =:= $past[0],
+ '$/[0] is correct for PAST::Pattern::VarList.');
+}
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
More information about the parrot-commits
mailing list