add OPpDEREFed flag to avoid double mg_get()

    The previous commit made various ops such as rv2av unconditionally do
    an SvGETMAGIC(). Under some circumstances this could cause a double
    mg_get() (and hence double FETCH etc). In particular, when the
    proceeding op was something like aelem with OPpDEREF, the aelem would
    call vivify_ref(), which would call magic. So in peep(), mark
    OP_RV2[SAH]V ops with the new OPpDEREFed flag if the preceding op was
    OPpDEREF. Then use this flag to avoid a second dose of magic.

    Note that RV2GV probably needs this flag too, but there weren't any
    spare private flag bits left for that op (I think).

diff --git a/dump.c b/dump.c
index 631f37c..46af01a 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -928,6 +928,11 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
                if (o->op_private & OPpMAYBE_LVSUB)
                    sv_catpv(tmpsv, ",MAYBE_LVSUB");
            }
+
+           if ((optype==OP_RV2SV || optype==OP_RV2AV || optype==OP_RV2HV)
+                   && (o->op_private & OPpDEREFed))
+               sv_catpv(tmpsv, ",DEREFed");
+
            if (optype == OP_AELEM || optype == OP_HELEM) {
                if (o->op_private & OPpLVAL_DEFER)
                    sv_catpv(tmpsv, ",LVAL_DEFER");

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 2699605..04e93cd 100644 (file)
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -606,6 +606,7 @@ $priv{$_}{64} = "RTIME" for ("match", "subst", "substcont", "qr");
                                    "COMPL", "GROWS");
 $priv{"repeat"}{64} = "DOLIST";
 $priv{"leaveloop"}{64} = "CONT";
+$priv{$_}{4} = "DREFed" for (qw(rv2sv rv2av rv2hv));
 @{$priv{$_}}{32,64,96} = ("DREFAV", "DREFHV", "DREFSV")
   for (qw(rv2gv rv2sv padsv aelem helem));
 $priv{$_}{16} = "STATE" for ("padav", "padhv", "padsv");

diff --git a/ext/B/t/f_sort.t b/ext/B/t/f_sort.t
index 6a36fcb..b940345 100644 (file)
--- a/ext/B/t/f_sort.t
+++ b/ext/B/t/f_sort.t
@@ -518,7 +518,7 @@ checkOptree(name   => q{Compound sort/map Expression },
 # l  <|> mapwhile(other->m)[t26] lK
 # m      <#> gv[*_] s
 # n      <1> rv2sv sKM/DREFAV,1
-# o      <1> rv2av[t4] sKR/1
+# o      <1> rv2av[t4] sKR/DEREFed,1
 # p      <$> const[IV 0] s
 # q      <2> aelem sK/2
 # -      <@> scope lK
@@ -553,7 +553,7 @@ EOT_EOT
 # l  <|> mapwhile(other->m)[t12] lK
 # m      <$> gv(*_) s
 # n      <1> rv2sv sKM/DREFAV,1
-# o      <1> rv2av[t2] sKR/1
+# o      <1> rv2av[t2] sKR/DREFed,1
 # p      <$> const(IV 0) s
 # q      <2> aelem sK/2
 # -      <@> scope lK

diff --git a/op.c b/op.c
index 40ef4bc..da0ad2c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -8877,6 +8877,20 @@ Perl_peep(pTHX_ register OP *o)
            }
            break;
        }
+       case OP_RV2SV:
+       case OP_RV2AV:
+       case OP_RV2HV:
+           if (oldop
+                && (  oldop->op_type == OP_AELEM
+                   || oldop->op_type == OP_PADSV
+                   || oldop->op_type == OP_RV2SV
+                   || oldop->op_type == OP_RV2GV
+                   || oldop->op_type == OP_HELEM
+                   )
+                && (oldop->op_private & OPpDEREF)
+           ) {
+               o->op_private |= OPpDEREFed;
+           }
 
        case OP_SORT: {
            /* will point to RV2AV or PADAV op on LHS/RHS of assign */

diff --git a/op.h b/op.h
index b9327bb..b66c4a1 100644 (file)
--- a/op.h
+++ b/op.h
@@ -191,6 +191,8 @@ Deprecated.  Use C<GIMME_V> instead.
 #define OPpDEREF_AV            32      /*   Want ref to AV. */
 #define OPpDEREF_HV            64      /*   Want ref to HV. */
 #define OPpDEREF_SV            (32|64) /*   Want ref to SV. */
+/* Private for OP_RV2SV, OP_RV2AV, OP_RV2AV */
+#define OPpDEREFed             4       /* prev op was OPpDEREF */
   /* OP_ENTERSUB only */
 #define OPpENTERSUB_DB         16      /* Debug subroutine. */
 #define OPpENTERSUB_HASTARG    32      /* Called from OP tree. */

diff --git a/pp.c b/pp.c
index d6e3132..937fdfd 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -272,7 +272,8 @@ PP(pp_rv2sv)
     dVAR; dSP; dTOPss;
     GV *gv = NULL;
 
-    SvGETMAGIC(sv);
+    if (!(PL_op->op_private & OPpDEREFed))
+       SvGETMAGIC(sv);
     if (SvROK(sv)) {
        tryAMAGICunDEREF(to_sv);
 

diff --git a/pp_hot.c b/pp_hot.c
index d5c13fe..a8c06b8 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -820,7 +820,8 @@ PP(pp_rv2av)
     const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV;
     const svtype type = is_pp_rv2av ? SVt_PVAV : SVt_PVHV;
 
-    SvGETMAGIC(sv);
+    if (!(PL_op->op_private & OPpDEREFed))
+       SvGETMAGIC(sv);
     if (SvROK(sv)) {
        tryAMAGICunDEREF_var(is_pp_rv2av ? to_av_amg : to_hv_amg);