[perl #115736] fix undocumented param from newATTRSUB_flags

flags param was poorly designed and didn't have a formal api. Replace it
with the bool it really is. See #115736 for details.

diff --git a/embed.fnc b/embed.fnc
index 422f6d1..2b82824 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1705,10 +1705,10 @@ Apd     |SV*    |sv_rvweaken    |NN SV *const sv
 : This is indirectly referenced by globals.c. This is somewhat annoying.
 p      |int    |magic_killbackrefs|NN SV *sv|NN MAGIC *mg
 Ap     |OP*    |newANONATTRSUB |I32 floor|NULLOK OP *proto|NULLOK OP *attrs|NULLOK OP *block
-Ap     |CV*    |newATTRSUB     |I32 floor|NULLOK OP *o|NULLOK OP *proto|NULLOK OP *attrs|NULLOK OP *block
-p      |CV*    |newATTRSUB_flags|I32 floor|NULLOK OP *o|NULLOK OP *proto \
+Am     |CV*    |newATTRSUB     |I32 floor|NULLOK OP *o|NULLOK OP *proto|NULLOK OP *attrs|NULLOK OP *block
+pX     |CV*    |newATTRSUB_x   |I32 floor|NULLOK OP *o|NULLOK OP *proto \
                                 |NULLOK OP *attrs|NULLOK OP *block \
-                                |U32 flags
+                                |bool o_is_gv
 Ap     |CV *   |newMYSUB       |I32 floor|NN OP *o|NULLOK OP *proto \
                                |NULLOK OP *attrs|NULLOK OP *block
 p      |CV*    |newSTUB        |NN GV *gv|bool fake

diff --git a/embed.h b/embed.h
index d25bb11..9e3af8b 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -343,7 +343,6 @@
 #define newANONLIST(a)         Perl_newANONLIST(aTHX_ a)
 #define newANONSUB(a,b,c)      Perl_newANONSUB(aTHX_ a,b,c)
 #define newASSIGNOP(a,b,c,d)   Perl_newASSIGNOP(aTHX_ a,b,c,d)
-#define newATTRSUB(a,b,c,d,e)  Perl_newATTRSUB(aTHX_ a,b,c,d,e)
 #define newAVREF(a)            Perl_newAVREF(aTHX_ a)
 #define newBINOP(a,b,c,d)      Perl_newBINOP(aTHX_ a,b,c,d)
 #define newCONDOP(a,b,c,d)     Perl_newCONDOP(aTHX_ a,b,c,d)
@@ -1193,7 +1192,7 @@
 #define my_lstat_flags(a)      Perl_my_lstat_flags(aTHX_ a)
 #define my_stat_flags(a)       Perl_my_stat_flags(aTHX_ a)
 #define my_unexec()            Perl_my_unexec(aTHX)
-#define newATTRSUB_flags(a,b,c,d,e,f)  Perl_newATTRSUB_flags(aTHX_ a,b,c,d,e,f)
+#define newATTRSUB_x(a,b,c,d,e,f)      Perl_newATTRSUB_x(aTHX_ a,b,c,d,e,f)
 #define newSTUB(a,b)           Perl_newSTUB(aTHX_ a,b)
 #define newSVavdefelem(a,b,c)  Perl_newSVavdefelem(aTHX_ a,b,c)
 #define newXS_len_flags(a,b,c,d,e,f,g) Perl_newXS_len_flags(aTHX_ a,b,c,d,e,f,g)

diff --git a/gv.c b/gv.c
index 686f206..bda30b1 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -540,7 +540,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
        CvLVALUE_on(cv);
         /* newATTRSUB will free the CV and return NULL if we're still
            compiling after a syntax error */
-       if ((cv = newATTRSUB_flags(
+       if ((cv = newATTRSUB_x(
                   oldsavestack_ix, (OP *)gv,
                   NULL,NULL,
                   coresub_op(
@@ -549,7 +549,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
                       : newSVpvn(name,len),
                     code, opnum
                   ),
-                  1
+                  TRUE
                )) != NULL) {
             assert(GvCV(gv) == orig_cv);
             if (opnum != OP_VEC && opnum != OP_SUBSTR && opnum != OP_POS

diff --git a/mathoms.c b/mathoms.c
index 0543e88..2f91e57 100644 (file)
--- a/mathoms.c
+++ b/mathoms.c
@@ -1170,7 +1170,7 @@ Perl_custom_op_desc(pTHX_ const OP* o)
 CV *
 Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block)
 {
-    return Perl_newATTRSUB(aTHX_ floor, o, proto, NULL, block);
+    return newATTRSUB(floor, o, proto, NULL, block);
 }
 
 UV

diff --git a/op.c b/op.c
index f25112a..f411009 100644 (file)
--- a/op.c
+++ b/op.c
@@ -7645,15 +7645,10 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     return cv;
 }
 
+/* _x = extended */
 CV *
-Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
-{
-    return newATTRSUB_flags(floor, o, proto, attrs, block, 0);
-}
-
-CV *
-Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
-                           OP *block, U32 flags)
+Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
+                           OP *block, bool o_is_gv)
 {
     dVAR;
     GV *gv;
@@ -7674,7 +7669,6 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
           || PL_madskills)
        ? GV_ADDMULTI : GV_ADDMULTI | GV_NOINIT;
     STRLEN namlen = 0;
-    const bool o_is_gv = flags & 1;
     const char * const name =
         o ? SvPV_const(o_is_gv ? (SV *)o : cSVOPo->op_sv, namlen) : NULL;
     bool has_name;

diff --git a/op.h b/op.h
index 0b84594..a1869ae 100644 (file)
--- a/op.h
+++ b/op.h
@@ -1022,7 +1022,8 @@ type.
 #define OP_TYPE_IS(o, type) ((o) && (o)->op_type == (type))
 
 
-#define newSUB(f, o, p, b)     Perl_newATTRSUB(aTHX_ (f), (o), (p), NULL, (b))
+#define newATTRSUB(f, o, p, a, b) Perl_newATTRSUB_x(aTHX_  f, o, p, a, b, FALSE)
+#define newSUB(f, o, p, b)     newATTRSUB((f), (o), (p), NULL, (b))
 
 #ifdef PERL_MAD
 #  define MAD_NULL 1

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index a30c98a..98bd8d8 100644 (file)
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -324,6 +324,12 @@ well.
 
 =over 4
 
+=item newATTRSUB is now a macro
+
+The public API newATTRSUB was previously a macro to the private
+function Perl_newATTRSUB. Function Perl_newATTRSUB has been removed. newATTRSUB
+is now macro to a different internal function.
+
 =item *
 
 XXX

diff --git a/proto.h b/proto.h
index 221d14a..6943041 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2707,8 +2707,8 @@ PERL_CALLCONV OP* Perl_newASSIGNOP(pTHX_ I32 flags, OP* left, I32 optype, OP* ri
                        __attribute__malloc__
                        __attribute__warn_unused_result__;
 
-PERL_CALLCONV CV*      Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block);
-PERL_CALLCONV CV*      Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block, U32 flags);
+/* PERL_CALLCONV CV*   newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block); */
+PERL_CALLCONV CV*      Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block, bool o_is_gv);
 /* PERL_CALLCONV AV*   Perl_newAV(pTHX)
                        __attribute__warn_unused_result__; */