A workaround for the role outer scopes bug. It's not perfect, and it'…

…s certainly not the real fix, but it avoids the issue and saves us an awkward FAQ.

src/Perl6/Actions.pm

@@ -64,6 +64,18 @@ method comp_unit($/, $key?) {
         return 1;
     }
 
+    # XXX To work around the role outers bug, we need to fix up the
+    # contexts marked for re-capture.
+    $mainline.unshift(PAST::Op.new(
+        :inline('    $P0 = get_hll_global "@!recapture"',
+                '  recapture_loop:',
+                '    unless $P0 goto recapture_loop_end',
+                '    $P1 = shift $P0',
+                '    fixup_outer_ctx $P1',
+                '    goto recapture_loop',
+                '  recapture_loop_end:',)
+    ));
+
     $unit.loadinit.unshift(
         PAST::Op.new(
             :name('!UNIT_OUTER'),

src/Perl6/Compiler/Role.pm

@@ -76,7 +76,7 @@ method finish($block) {
             :pasttype('callmethod'),
             :name('add_method'),
             $meta_reg, $obj_reg, ~$_, 
-             PAST::Op.new( :pasttype('callmethod'), :name('clone'), %methods{~$_}<code_ref> )
+            PAST::Op.new( :pasttype('callmethod'), :name('clone'), %methods{~$_}<code_ref> )
         ));
     }
 
@@ -107,6 +107,23 @@ method finish($block) {
     # Call compose to create the role object.
     $decl.push(PAST::Op.new( :pasttype('callmethod'), :name('compose'), $meta_reg, $obj_reg ));
 
+    # XXX If it's our-scoped, we need to also save a reference to the current
+    # context since we need to fixup its outer_ctx later from the main program
+    # body. Complete band-aid that we should be able to kill in the not too
+    # distant future, but the bug is nasty.
+    if !$*SETTING_MODE && ($!scope eq 'our' || $!scope eq '') {
+        $decl.unshift(PAST::Op.new(
+            :inline('    $P0 = getinterp',
+                    '    $P0 = $P0["context"]',
+                    '    $P1 = get_hll_global "@!recapture"',
+                    '    unless null $P1 goto got_recapture_list',
+                    '    $P1 = root_new ["parrot";"ResizablePMCArray"]',
+                    '    set_hll_global "@!recapture", $P1',
+                    '  got_recapture_list:',
+                    '    push $P1, $P0')
+        ));
+    }
+
     # We need the block to get the signature, or a default one, plus the
     # decl code as a body.
     my $sig := pir::defined__IP($!signature) ?? $!signature !! Perl6::Compiler::Signature.new();

src/ops/perl6.ops

@@ -10,6 +10,7 @@ BEGIN_OPS_PREAMBLE
 #include "pmc_object.h"
 #include "pmc_class.h"
 #include "pmc_callcontext.h"
+#include "pmc_sub.h"
 #include "../pmc/pmc_p6lowlevelsig.h"
 #include "../binder/bind.h"
 
@@ -710,6 +711,27 @@ inline op find_method_null_ok(out PMC, in PMC, in STR) :base_core {
     goto NEXT();
 }
 
+
+/*
+
+=item fixup_outer_ctx(inout PMC)
+
+=cut
+
+*/
+inline op fixup_outer_ctx(inout PMC) :base_core {
+    PMC *cur_ctx = CURRENT_CONTEXT(interp);
+    if ($1->vtable->base_type == enum_class_CallContext) {
+        Parrot_pcc_set_outer_ctx(interp, $1, cur_ctx);
+        goto NEXT();
+    }
+    else {
+        opcode_t *handler =  Parrot_ex_throw_from_op_args(interp, NULL,
+                EXCEPTION_INVALID_OPERATION, "fixup_outer_ctx only valid on a context");
+        goto ADDRESS(handler);
+    }
+}
+
 /*
  * Local variables:
  *   c-file-style: "parrot"