This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
op.c: Disentangle apply_attrs_my from apply_attrs
authorFather Chrysostomos <sprout@cpan.org>
Thu, 20 Sep 2012 05:03:55 +0000 (22:03 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 20 Sep 2012 05:03:55 +0000 (22:03 -0700)
apply_attrs consisted of a top-level if/else conditional upon a bool-
ean argument.  It was being called with a TRUE argument in only one
place, apply_attrs_my.  Inlining that branch into apply_attrs_my actu-
ally reduces the amount of code slightly.

embed.fnc
embed.h
op.c
proto.h

index 8553fb8..8b03b25 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1759,7 +1759,7 @@ s |SV*    |gv_ename       |NN GV *gv
 sRn    |bool   |scalar_mod_type|NULLOK const OP *o|I32 type
 s      |OP *   |my_kid         |NULLOK OP *o|NULLOK OP *attrs|NN OP **imopsp
 s      |OP *   |dup_attrlist   |NN OP *o
-s      |void   |apply_attrs    |NN HV *stash|NN SV *target|NULLOK OP *attrs|bool for_my
+s      |void   |apply_attrs    |NN HV *stash|NN SV *target|NULLOK OP *attrs
 s      |void   |apply_attrs_my |NN HV *stash|NN OP *target|NULLOK OP *attrs|NN OP **imopsp
 s      |void   |bad_type_pv    |I32 n|NN const char *t|NN const char *name|U32 flags|NN const OP *kid
 s      |void   |bad_type_sv    |I32 n|NN const char *t|NN SV *namesv|U32 flags|NN const OP *kid
diff --git a/embed.h b/embed.h
index e0afb12..79e10a8 100644 (file)
--- a/embed.h
+++ b/embed.h
 #  endif
 #  if defined(PERL_IN_OP_C)
 #define aassign_common_vars(a) S_aassign_common_vars(aTHX_ a)
-#define apply_attrs(a,b,c,d)   S_apply_attrs(aTHX_ a,b,c,d)
+#define apply_attrs(a,b,c)     S_apply_attrs(aTHX_ a,b,c)
 #define apply_attrs_my(a,b,c,d)        S_apply_attrs_my(aTHX_ a,b,c,d)
 #define bad_type_pv(a,b,c,d,e) S_bad_type_pv(aTHX_ a,b,c,d,e)
 #define bad_type_sv(a,b,c,d,e) S_bad_type_sv(aTHX_ a,b,c,d,e)
diff --git a/op.c b/op.c
index 9a2f917..1406ffc 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2450,9 +2450,10 @@ S_dup_attrlist(pTHX_ OP *o)
 }
 
 STATIC void
-S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
+S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
 {
     dVAR;
+    SV * const stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
 
     PERL_ARGS_ASSERT_APPLY_ATTRS;
 
@@ -2462,19 +2463,7 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
 #define ATTRSMODULE "attributes"
 #define ATTRSMODULE_PM "attributes.pm"
 
-    if (for_my) {
-       /* Don't force the C<use> if we don't need it. */
-       SV * const * const svp = hv_fetchs(GvHVn(PL_incgv), ATTRSMODULE_PM, FALSE);
-       if (svp && *svp != &PL_sv_undef)
-           NOOP;       /* already in %INC */
-       else
-           Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
-                            newSVpvs(ATTRSMODULE), NULL);
-    }
-    else {
-       SV * const stashsv =
-           stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
-       Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS,
+    Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS,
                         newSVpvs(ATTRSMODULE),
                         NULL,
                         op_prepend_elem(OP_LIST,
@@ -2483,7 +2472,6 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
                                                   newSVOP(OP_CONST, 0,
                                                           newRV(target)),
                                                   dup_attrlist(attrs))));
-    }
     LEAVE;
 }
 
@@ -2492,7 +2480,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
 {
     dVAR;
     OP *pack, *imop, *arg;
-    SV *meth, *stashsv;
+    SV *meth, *stashsv, **svp;
 
     PERL_ARGS_ASSERT_APPLY_ATTRS_MY;
 
@@ -2504,7 +2492,15 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
           target->op_type == OP_PADAV);
 
     /* Ensure that attributes.pm is loaded. */
-    apply_attrs(stash, PAD_SV(target->op_targ), attrs, TRUE);
+    ENTER;             /* need to protect against side-effects of 'use' */
+    /* Don't force the C<use> if we don't need it. */
+    svp = hv_fetchs(GvHVn(PL_incgv), ATTRSMODULE_PM, FALSE);
+    if (svp && *svp != &PL_sv_undef)
+       NOOP;   /* already in %INC */
+    else
+       Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
+                              newSVpvs(ATTRSMODULE), NULL);
+    LEAVE;
 
     /* Need package name for method call. */
     pack = newSVOP(OP_CONST, 0, newSVpvs(ATTRSMODULE));
@@ -2624,7 +2620,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
                        (type == OP_RV2SV ? GvSV(gv) :
                         type == OP_RV2AV ? MUTABLE_SV(GvAV(gv)) :
                         type == OP_RV2HV ? MUTABLE_SV(GvHV(gv)) : MUTABLE_SV(gv)),
-                       attrs, FALSE);
+                       attrs);
        }
        o->op_private |= OPpOUR_INTRO;
        return o;
@@ -7243,7 +7239,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
   attrs:
     if (attrs) {
        /* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>. */
-       apply_attrs(PL_curstash, MUTABLE_SV(cv), attrs, FALSE);
+       apply_attrs(PL_curstash, MUTABLE_SV(cv), attrs);
     }
 
     if (block) {
@@ -7640,7 +7636,7 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
     if (attrs) {
        /* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>. */
        HV *stash = name && GvSTASH(CvGV(cv)) ? GvSTASH(CvGV(cv)) : PL_curstash;
-       apply_attrs(stash, MUTABLE_SV(cv), attrs, FALSE);
+       apply_attrs(stash, MUTABLE_SV(cv), attrs);
     }
 
     if (block && has_name) {
diff --git a/proto.h b/proto.h
index f662929..94ad613 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5737,7 +5737,7 @@ STATIC NV S_mulexp10(NV value, I32 exponent);
 #endif
 #if defined(PERL_IN_OP_C)
 PERL_STATIC_INLINE bool        S_aassign_common_vars(pTHX_ OP* o);
-STATIC void    S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
+STATIC void    S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_APPLY_ATTRS   \