Restore special blocks to working order

I accidentally broke these in commit 85ffec3682, yet everything passed
for me under threads+mad.

PL_compcv is usually restored to its previous value at the end of
newATTRSUB when LEAVE_SCOPE is called.  But BEGIN blocks are called
before that.  I needed PL_compcv to be restored to its previ-
ous value before it was called, so I added LEAVE_SCOPE before
process_special_blocks.

But that caused the name to be freed before S_process_special_blocks
got a chance to look at it.

So I have now added a new parameter to S_process_special_blocks to
allow *it* to call LEAVE_SCOPE after it determines that it is a BEGIN
block, but before it calls it.

diff --git a/embed.fnc b/embed.fnc
index 8aa3efb..aa64815 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1776,7 +1776,8 @@ s |OP*    |newGIVWHENOP   |NULLOK OP* cond|NN OP *block \
                                |I32 enter_opcode|I32 leave_opcode \
                                |PADOFFSET entertarg
 s      |OP*    |ref_array_or_hash|NULLOK OP* cond
-s      |void   |process_special_blocks |NN const char *const fullname\
+s      |void   |process_special_blocks |I32 floor \
+                                       |NN const char *const fullname\
                                        |NN GV *const gv|NN CV *const cv
 #endif
 Xpa    |void*  |Slab_Alloc     |size_t sz

diff --git a/embed.h b/embed.h
index 72501d0..f5aa4b8 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1415,7 +1415,7 @@
 #define op_integerize(a)       S_op_integerize(aTHX_ a)
 #define op_std_init(a)         S_op_std_init(aTHX_ a)
 #define pmtrans(a,b,c)         S_pmtrans(aTHX_ a,b,c)
-#define process_special_blocks(a,b,c)  S_process_special_blocks(aTHX_ a,b,c)
+#define process_special_blocks(a,b,c,d)        S_process_special_blocks(aTHX_ a,b,c,d)
 #define ref_array_or_hash(a)   S_ref_array_or_hash(aTHX_ a)
 #define refkids(a,b)           S_refkids(aTHX_ a,b)
 #define scalar_mod_type                S_scalar_mod_type

diff --git a/op.c b/op.c
index dfc1cd7..87e2e52 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7663,10 +7663,7 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
        }
 
        if (name && ! (PL_parser && PL_parser->error_count))
-       {
-           LEAVE_SCOPE(floor);
-           process_special_blocks(name, gv, cv);
-       }
+           process_special_blocks(floor, name, gv, cv);
     }
 
   done:
@@ -7681,7 +7678,8 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 }
 
 STATIC void
-S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
+S_process_special_blocks(pTHX_ I32 floor, const char *const fullname,
+                        GV *const gv,
                         CV *const cv)
 {
     const char *const colon = strrchr(fullname,':');
@@ -7692,6 +7690,7 @@ S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
     if (*name == 'B') {
        if (strEQ(name, "BEGIN")) {
            const I32 oldscope = PL_scopestack_ix;
+           if (floor) LEAVE_SCOPE(floor);
            ENTER;
            SAVECOPFILE(&PL_compiling);
            SAVECOPLINE(&PL_compiling);
@@ -7906,7 +7905,7 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
         CvXSUB(cv) = subaddr;
     
         if (name)
-            process_special_blocks(name, gv, cv);
+            process_special_blocks(0, name, gv, cv);
     }
 
     if (flags & XS_DYNAMIC_FILENAME) {

diff --git a/proto.h b/proto.h
index f2c9d24..fa69fa9 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5866,10 +5866,10 @@ STATIC OP*      S_pmtrans(pTHX_ OP* o, OP* expr, OP* repl)
 #define PERL_ARGS_ASSERT_PMTRANS       \
        assert(o); assert(expr); assert(repl)
 
-STATIC void    S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv, CV *const cv)
-                       __attribute__nonnull__(pTHX_1)
+STATIC void    S_process_special_blocks(pTHX_ I32 floor, const char *const fullname, GV *const gv, CV *const cv)
                        __attribute__nonnull__(pTHX_2)
-                       __attribute__nonnull__(pTHX_3);
+                       __attribute__nonnull__(pTHX_3)
+                       __attribute__nonnull__(pTHX_4);
 #define PERL_ARGS_ASSERT_PROCESS_SPECIAL_BLOCKS        \
        assert(fullname); assert(gv); assert(cv)
 

diff --git a/scope.h b/scope.h
index 0fad9a3..447d22e 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -162,7 +162,9 @@ scope has the given name. Name must be a literal string.
 #define ENTER_with_name(name) ENTER
 #define LEAVE_with_name(name) LEAVE
 #endif
-#define LEAVE_SCOPE(old) if (PL_savestack_ix > old) leave_scope(old)
+#define LEAVE_SCOPE(old) STMT_START { \
+       if (PL_savestack_ix > old) leave_scope(old); \
+    } STMT_END
 
 #define SAVEI8(i)      save_I8((I8*)&(i))
 #define SAVEI16(i)     save_I16((I16*)&(i))