Preserve 6.c Regex.Bool behavior

rakudo · Jan 28, 2019 · 3d581c8 · 3d581c8
1 parent 8ef7c15
commit 3d581c8
Show file tree

Hide file tree

Showing 3 changed files with 41 additions and 10 deletions.
diff --git a/src/Perl6/Actions.nqp b/src/Perl6/Actions.nqp
@@ -16,13 +16,17 @@ my $abbrev-block := 'abbreviated';
 my int $?BITS := nqp::isgt_i(nqp::add_i(2147483648, 1), 0) ?? 64 !! 32;
 
 sub block_closure($code, :$regex) {
-    my $clone := $regex
-        ?? QAST::Op.new(
-            :op('callmethod'), :name('clone'), $code,
-            QAST::Var.new( :name('$_'), :scope('lexical'), :named('topic') ),
-            QAST::Var.new( :name('$/'), :scope('lexical'), :named('slash') ),
-           )
-        !! QAST::Op.new( :op('callmethod'), :name('clone'), $code );
+    my $clone := QAST::Op.new( :op('callmethod'), :name('clone'), $code );
+    if $regex {
+        if $*W.lang-ver-before('d') {
+            my $marker := $*W.find_symbol(['Rakudo', 'Internals', 'RegexBoolification6cMarker']);
+            $clone.push(QAST::WVal.new( :value($marker), :named('topic') ));
+        }
+        else {
+            $clone.push(QAST::Var.new( :name('$_'), :scope('lexical'), :named('topic') ));
+            $clone.push(QAST::Var.new( :name('$/'), :scope('lexical'), :named('slash') ));
+        }
+    }
     QAST::Op.new( :op('p6capturelex'), $clone ).annotate_self(
         'past_block', $code.ann('past_block')
     ).annotate_self(

diff --git a/src/core/Rakudo/Internals.pm6 b/src/core/Rakudo/Internals.pm6
@@ -41,6 +41,9 @@ my class Rakudo::Internals {
         method dynamic() { False }
     }
 
+    # Marker symbol for 6.c-mode regex boolification.
+    class RegexBoolification6cMarker { }
+
     # rotate nqp list to another given list without using push/pop
     method RotateListToList(\from,\n,\to) {
         nqp::stmts(

diff --git a/src/core/Regex.pm6 b/src/core/Regex.pm6
@@ -83,9 +83,33 @@ my class Regex { # declared in BOOTSTRAP
     }
 
     multi method Bool(Regex:D:) {
-        nqp::isconcrete($!topic)
-            ?? ($!slash = $!topic.match(self)).Bool
-            !! False
+        my Mu \topic = $!topic;
+        nqp::istype_nd(topic, Rakudo::Internals::RegexBoolification6cMarker)
+            ?? self!Bool6c()
+            !! nqp::isconcrete(topic)
+                ?? ($!slash = topic.match(self)).Bool
+                !! False
+    }
+
+    method !Bool6c() {
+        nqp::stmts(
+          (my $ctx := nqp::ctx),
+          nqp::until(
+            nqp::isnull($ctx := nqp::ctxcallerskipthunks($ctx))
+              || nqp::isconcrete(
+                   my $underscore := nqp::getlexrelcaller($ctx,'$_')
+            ),
+            nqp::null
+          ),
+          nqp::if(
+            nqp::isnull($ctx),
+            False,
+            nqp::stmts(
+              (my $slash := nqp::getlexrelcaller($ctx,'$/')),
+              ($slash = $underscore.match(self)).Bool
+            )
+          )
+        )
     }
 
     multi method gist(Regex:D:) {