From e8f91c91cc7c3a4a35c08d16f350eabe4852cdf4 Mon Sep 17 00:00:00 2001 From: Daniel Dragan Date: Mon, 23 Dec 2013 02:11:29 -0500 Subject: [PATCH] [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. --- embed.fnc | 6 +++--- embed.h | 3 +-- gv.c | 4 ++-- mathoms.c | 2 +- op.c | 12 +++--------- op.h | 3 ++- pod/perldelta.pod | 6 ++++++ proto.h | 4 ++-- 8 files changed, 20 insertions(+), 20 deletions(-) diff --git a/embed.fnc b/embed.fnc index 422f6d1..2b82824 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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__; */ -- 2.7.4