avoid using freed ops on BEGIN :attr {}

If a BEGIN sub has a code attribute applied (no idea why you would want to
do such a thing, but it's not illegal) then part of applying the attribute
is to do 'use attributes', which compiles

    BEGIN { require "attributes"; attributes->import(AAA) }

so we end up compiling a BEGIN while in the middle of compiling a BEGIN.
The part of Perl_newATTRSUB_x() that under some circumstances copies
the body of the newly-compiled CV to the old CV which occupies the name
slot, kicks in here.

Since the ops that make up the AAA above were allocated from the old
BEGIN's op slabs, they get prematurely freed when the old BEGIN's
ops are discarded by the SvREFCNT_dec(PL_compcv).

The simplest fix is to just avoid the copy if we're compiling a BEGIN.

1 files changed, 21 insertions, 0 deletions

diff --git a/t/op/attrs.t b/t/op/attrs.t
index 23b00cadd5..318a9d6f4a 100644
--- a/t/op/attrs.t
+++ b/t/op/attrs.t
@@ -447,4 +447,25 @@ package P126257 {
     ::is $@, "", "RT 126257 sub";
 }
 
+# RT #129099
+# Setting an attribute on a BEGIN prototype causes
+#       BEGIN { require "attributes"; ... }
+# to be compiled, which caused problems with ops being prematurely
+# freed when CvSTART was transferred from the old BEGIN to the new BEGIN
+
+is runperl(
+       prog => 'package Foo; sub MODIFY_CODE_ATTRIBUTES {()} '
+             . 'sub BEGIN :Foo; print q{OK}',
+       stderr => 1,
+   ),
+   "OK",
+  'RT #129099 BEGIN';
+is runperl(
+       prog => 'package Foo; sub MODIFY_CODE_ATTRIBUTES {()} '
+             . 'no warnings q{prototype}; sub BEGIN() :Foo; print q{OK}',
+       stderr => 1,
+   ),
+   "OK",
+  'RT #129099 BEGIN()';
+
 done_testing();