Still use simple backref semantics for :Perl5.

Raku · Nov 12, 2015 · 6bd8e5b · 6bd8e5b
1 parent a54139b
commit 6bd8e5b
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 2 deletions.
diff --git a/src/QRegex/Cursor.nqp b/src/QRegex/Cursor.nqp
@@ -516,6 +516,22 @@ role NQPCursorRole is export {
         $cur;
     }
 
+    method !BACKREF-LATEST-CAPTURE($name) {
+        my $cur   := self."!cursor_start_cur"();
+        my int $n := $!cstack ?? nqp::elems($!cstack) - 1 !! -1;
+        $n-- while $n >= 0 && (nqp::isnull(nqp::getattr($!cstack[$n], $?CLASS, '$!name')) ||
+                               nqp::getattr($!cstack[$n], $?CLASS, '$!name') ne $name);
+        if $n >= 0 {
+            my $subcur := $!cstack[$n];
+            my int $litlen := $subcur.pos - $subcur.from;
+            my str $target := nqp::getattr_s($!shared, ParseShared, '$!target');
+            $cur."!cursor_pass"($!pos + $litlen, '')
+              if nqp::substr($target, $!pos, $litlen) 
+                   eq nqp::substr($target, $subcur.from, $litlen);
+        }
+        $cur;
+    }
+
     method !LITERAL($strish, int $i = 0) {
         if nqp::isconcrete($strish) {
             my str $str := $strish;

diff --git a/src/QRegex/P5Regex/Actions.nqp b/src/QRegex/P5Regex/Actions.nqp
@@ -257,7 +257,7 @@ class QRegex::P5Regex::Actions is HLL::Actions {
         else {
             make QAST::Regex.new( :rxtype<subrule>, :subtype<method>, :node($/),
                 QAST::NodeList.new(
-                    QAST::SVal.new( :value('!BACKREF') ),
+                    QAST::SVal.new( :value('!BACKREF-LATEST-CAPTURE') ),
                     QAST::SVal.new( :value(~$<number> - 1) ) ) );
         }
     }
@@ -532,7 +532,7 @@ class QRegex::P5Regex::Actions is HLL::Actions {
         else {
             $qast := QAST::Regex.new( :rxtype<subrule>, :subtype<method>, :node($/),
                 QAST::NodeList.new(
-                    QAST::SVal.new( :value('!BACKREF') ),
+                    QAST::SVal.new( :value('!BACKREF-LATEST-CAPTURE') ),
                     QAST::SVal.new( :value($name) ) ) );
         }
         make $qast;