This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move aassign common var detection to a separate function.
authorGerard Goossen <gerard@ggoossen.net>
Sat, 6 Aug 2011 15:23:03 +0000 (17:23 +0200)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 8 Aug 2011 22:49:44 +0000 (15:49 -0700)
embed.fnc
embed.h
op.c
proto.h

index f48d8ce..e230910 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -805,6 +805,9 @@ p   |void   |my_unexec
 Apa    |OP*    |newANONLIST    |NULLOK OP* o
 Apa    |OP*    |newANONHASH    |NULLOK OP* o
 Ap     |OP*    |newANONSUB     |I32 floor|NULLOK OP* proto|NULLOK OP* block
+#if defined(PERL_IN_OP_C)
+i      |bool   |aassign_common_vars    |NULLOK OP* o
+#endif
 Apda   |OP*    |newASSIGNOP    |I32 flags|NULLOK OP* left|I32 optype|NULLOK OP* right
 Apda   |OP*    |newCONDOP      |I32 flags|NN OP* first|NULLOK OP* trueop|NULLOK OP* falseop
 Apd    |CV*    |newCONSTSUB    |NULLOK HV* stash|NULLOK const char* name|NULLOK SV* sv
diff --git a/embed.h b/embed.h
index 0b3c4dc..7fc3b21 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define mulexp10               S_mulexp10
 #  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_my(a,b,c,d)        S_apply_attrs_my(aTHX_ a,b,c,d)
 #define bad_type(a,b,c,d)      S_bad_type(aTHX_ a,b,c,d)
diff --git a/op.c b/op.c
index 38cfc10..4187b50 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4799,6 +4799,73 @@ S_is_list_assignment(pTHX_ register const OP *o)
 }
 
 /*
+  Helper function for newASSIGNOP to detection commonality between the
+  lhs and the rhs.  Marks all variables with PL_generation.  If it
+  returns TRUE the assignment must be able to handle common variables.
+*/
+PERL_STATIC_INLINE bool
+S_aassign_common_vars(pTHX_ OP* o)
+{
+    OP *lastop = o;
+    OP *curop;
+    for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
+       if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
+           if (curop->op_type == OP_GV) {
+               GV *gv = cGVOPx_gv(curop);
+               if (gv == PL_defgv
+                   || (int)GvASSIGN_GENERATION(gv) == PL_generation)
+                   return TRUE;
+               GvASSIGN_GENERATION_set(gv, PL_generation);
+           }
+           else if (curop->op_type == OP_PADSV ||
+               curop->op_type == OP_PADAV ||
+               curop->op_type == OP_PADHV ||
+               curop->op_type == OP_PADANY)
+               {
+                   if (PAD_COMPNAME_GEN(curop->op_targ)
+                       == (STRLEN)PL_generation)
+                       return TRUE;
+                   PAD_COMPNAME_GEN_set(curop->op_targ, PL_generation);
+
+               }
+           else if (curop->op_type == OP_RV2CV)
+               return TRUE;
+           else if (curop->op_type == OP_RV2SV ||
+               curop->op_type == OP_RV2AV ||
+               curop->op_type == OP_RV2HV ||
+               curop->op_type == OP_RV2GV) {
+               if (lastop->op_type != OP_GV)   /* funny deref? */
+                   return TRUE;
+           }
+           else if (curop->op_type == OP_PUSHRE) {
+#ifdef USE_ITHREADS
+               if (((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff) {
+                   GV *const gv = MUTABLE_GV(PAD_SVl(((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff));
+                   if (gv == PL_defgv
+                       || (int)GvASSIGN_GENERATION(gv) == PL_generation)
+                       return TRUE;
+                   GvASSIGN_GENERATION_set(gv, PL_generation);
+               }
+#else
+               GV *const gv
+                   = ((PMOP*)curop)->op_pmreplrootu.op_pmtargetgv;
+               if (gv) {
+                   if (gv == PL_defgv
+                       || (int)GvASSIGN_GENERATION(gv) == PL_generation)
+                       return TRUE;
+                   GvASSIGN_GENERATION_set(gv, PL_generation);
+               }
+#endif
+           }
+           else
+               return TRUE;
+       }
+       lastop = curop;
+    }
+    return FALSE;
+}
+
+/*
 =for apidoc Am|OP *|newASSIGNOP|I32 flags|OP *left|I32 optype|OP *right
 
 Constructs, checks, and returns an assignment op.  I<left> and I<right>
@@ -4936,63 +5003,8 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
         */
 
        if (maybe_common_vars) {
-           OP *lastop = o;
            PL_generation++;
-           for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
-               if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
-                   if (curop->op_type == OP_GV) {
-                       GV *gv = cGVOPx_gv(curop);
-                       if (gv == PL_defgv
-                           || (int)GvASSIGN_GENERATION(gv) == PL_generation)
-                           break;
-                       GvASSIGN_GENERATION_set(gv, PL_generation);
-                   }
-                   else if (curop->op_type == OP_PADSV ||
-                            curop->op_type == OP_PADAV ||
-                            curop->op_type == OP_PADHV ||
-                            curop->op_type == OP_PADANY)
-                   {
-                       if (PAD_COMPNAME_GEN(curop->op_targ)
-                                                   == (STRLEN)PL_generation)
-                           break;
-                       PAD_COMPNAME_GEN_set(curop->op_targ, PL_generation);
-
-                   }
-                   else if (curop->op_type == OP_RV2CV)
-                       break;
-                   else if (curop->op_type == OP_RV2SV ||
-                            curop->op_type == OP_RV2AV ||
-                            curop->op_type == OP_RV2HV ||
-                            curop->op_type == OP_RV2GV) {
-                       if (lastop->op_type != OP_GV)   /* funny deref? */
-                           break;
-                   }
-                   else if (curop->op_type == OP_PUSHRE) {
-#ifdef USE_ITHREADS
-                       if (((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff) {
-                           GV *const gv = MUTABLE_GV(PAD_SVl(((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff));
-                           if (gv == PL_defgv
-                               || (int)GvASSIGN_GENERATION(gv) == PL_generation)
-                               break;
-                           GvASSIGN_GENERATION_set(gv, PL_generation);
-                       }
-#else
-                       GV *const gv
-                           = ((PMOP*)curop)->op_pmreplrootu.op_pmtargetgv;
-                       if (gv) {
-                           if (gv == PL_defgv
-                               || (int)GvASSIGN_GENERATION(gv) == PL_generation)
-                               break;
-                           GvASSIGN_GENERATION_set(gv, PL_generation);
-                       }
-#endif
-                   }
-                   else
-                       break;
-               }
-               lastop = curop;
-           }
-           if (curop != o)
+           if (aassign_common_vars(o))
                o->op_private |= OPpASSIGN_COMMON;
        }
 
diff --git a/proto.h b/proto.h
index 2c63536..1807b2f 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5458,6 +5458,7 @@ STATIC AV*        S_mro_get_linear_isa_dfs(pTHX_ HV* stash, U32 level)
 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)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);