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).

7 files changed, 28 insertions, 4 deletions

diff --git a/dump.c b/dump.c
index 631f37cbb2..46af01a8db 100644
--- 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 2699605894..04e93cd0e6 100644
--- 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 6a36fcb49b..b940345be7 100644
--- 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 40ef4bcd3d..da0ad2c710 100644
--- 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 b9327bbb1f..b66c4a1563 100644
--- 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 d6e3132fe6..937fdfd84f 100644
--- 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 d5c13fecd9..a8c06b85ae 100644
--- 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);