summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--dump.c4
-rw-r--r--embed.fnc2
-rw-r--r--ext/B/t/f_sort.t4
-rw-r--r--lib/overload.t2
-rw-r--r--op.c21
-rw-r--r--op.h2
-rw-r--r--pp.c5
-rw-r--r--pp_ctl.c6
-rw-r--r--pp_hot.c31
-rw-r--r--proto.h3
10 files changed, 28 insertions, 52 deletions
diff --git a/dump.c b/dump.c
index 232ab0167d..c99532ab58 100644
--- a/dump.c
+++ b/dump.c
@@ -1020,10 +1020,6 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
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/embed.fnc b/embed.fnc
index e7041b1042..2ed8f60ca1 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1384,7 +1384,7 @@ ApdR |char* |sv_uni_display |NN SV *dsv|NN SV *ssv|STRLEN pvlim|UV flags
: Used by Data::Alias
EXp |void |vivify_defelem |NN SV* sv
: Used in pp.c
-p |void |vivify_ref |NN SV* sv|U32 to_what
+pR |SV* |vivify_ref |NN SV* sv|U32 to_what
: Used in pp_sys.c
p |I32 |wait4pid |Pid_t pid|NN int* statusp|int flags
: Used in locale.c and perl.c
diff --git a/ext/B/t/f_sort.t b/ext/B/t/f_sort.t
index d5288a519a..58a8cf2eed 100644
--- a/ext/B/t/f_sort.t
+++ b/ext/B/t/f_sort.t
@@ -517,7 +517,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/DREFed,1
+# o <1> rv2av[t4] sKR/1
# p <$> const[IV 0] s
# q <2> aelem sK/2
# - <@> scope lK
@@ -552,7 +552,7 @@ EOT_EOT
# l <|> mapwhile(other->m)[t12] lK
# m <$> gv(*_) s
# n <1> rv2sv sKM/DREFAV,1
-# o <1> rv2av[t2] sKR/DREFed,1
+# o <1> rv2av[t2] sKR/1
# p <$> const(IV 0) s
# q <2> aelem sK/2
# - <@> scope lK
diff --git a/lib/overload.t b/lib/overload.t
index 12ed55be7c..605429ede9 100644
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -1820,7 +1820,7 @@ foreach my $op (qw(<=> == != < <= > >=)) {
$subs{'%{}'} = '%s';
push @tests, [ {qw(a 1 b 2 c 3)}, 'join "", sort keys %%{%s}',
- '(%{})', undef, [ 1, 2, 0 ], 0 ];
+ '(%{})', undef, [ 1, 1, 0 ], 0 ];
$subs{'&{}'} = '%s';
push @tests, [ sub {99}, 'do {&{%s} for 1,2}',
diff --git a/op.c b/op.c
index 01211e6fcf..395b46b283 100644
--- a/op.c
+++ b/op.c
@@ -9972,27 +9972,6 @@ Perl_rpeep(pTHX_ register OP *o)
DEFER(cPMOP->op_pmstashstartu.op_pmreplstart);
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)
- )
- || ( oldop->op_type == OP_ENTERSUB
- && oldop->op_private & OPpENTERSUB_DEREF )
- )
- ) {
- o->op_private |= OPpDEREFed;
- }
-
case OP_SORT: {
/* will point to RV2AV or PADAV op on LHS/RHS of assign */
OP *oleft;
diff --git a/op.h b/op.h
index 6a6e3f2d10..e0fdc81778 100644
--- a/op.h
+++ b/op.h
@@ -201,8 +201,6 @@ 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. */
diff --git a/pp.c b/pp.c
index a5691ee736..2894e3b378 100644
--- a/pp.c
+++ b/pp.c
@@ -314,8 +314,7 @@ PP(pp_rv2sv)
dVAR; dSP; dTOPss;
GV *gv = NULL;
- if (!(PL_op->op_private & OPpDEREFed))
- SvGETMAGIC(sv);
+ SvGETMAGIC(sv);
if (SvROK(sv)) {
if (SvAMAGIC(sv)) {
sv = amagic_deref_call(sv, to_sv_amg);
@@ -353,7 +352,7 @@ PP(pp_rv2sv)
Perl_croak(aTHX_ "%s", PL_no_localize_ref);
}
else if (PL_op->op_private & OPpDEREF)
- vivify_ref(sv, PL_op->op_private & OPpDEREF);
+ sv = vivify_ref(sv, PL_op->op_private & OPpDEREF);
}
SETs(sv);
RETURN;
diff --git a/pp_ctl.c b/pp_ctl.c
index fc54f99391..dc1b055681 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2373,7 +2373,7 @@ S_return_lvalues(pTHX_ SV **mark, SV **sp, SV **newsp, I32 gimme,
assert(cx->blk_sub.retop->op_type == OP_RV2HV);
deref_type = OPpDEREF_HV;
}
- vivify_ref(TOPs, deref_type);
+ TOPs = vivify_ref(TOPs, deref_type);
}
}
}
@@ -2423,7 +2423,6 @@ PP(pp_return)
bool popsub2 = FALSE;
bool clear_errsv = FALSE;
bool lval = FALSE;
- bool gmagic = FALSE;
I32 gimme;
SV **newsp;
PMOP *newpm;
@@ -2466,7 +2465,6 @@ PP(pp_return)
popsub2 = TRUE;
lval = !!CvLVALUE(cx->blk_sub.cv);
retop = cx->blk_sub.retop;
- gmagic = CxLVAL(cx) & OPpENTERSUB_DEREF;
cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
break;
case CXt_EVAL:
@@ -2506,7 +2504,6 @@ PP(pp_return)
*++newsp = SvREFCNT_inc(*SP);
FREETMPS;
sv_2mortal(*newsp);
- if (gmagic) SvGETMAGIC(*newsp);
}
else {
sv = SvREFCNT_inc(*SP); /* FREETMPS could clobber it */
@@ -2517,7 +2514,6 @@ PP(pp_return)
}
else if (SvTEMP(*SP) && SvREFCNT(*SP) == 1) {
*++newsp = *SP;
- if (gmagic) SvGETMAGIC(*SP);
}
else
*++newsp = sv_mortalcopy(*SP);
diff --git a/pp_hot.c b/pp_hot.c
index 2f159e5fd5..dd0b04d6cd 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -311,7 +311,7 @@ PP(pp_padsv)
SAVECLEARSV(PAD_SVl(PL_op->op_targ));
if (PL_op->op_private & OPpDEREF) {
PUTBACK;
- vivify_ref(PAD_SVl(PL_op->op_targ), PL_op->op_private & OPpDEREF);
+ TOPs = vivify_ref(TOPs, PL_op->op_private & OPpDEREF);
SPAGAIN;
}
}
@@ -759,8 +759,7 @@ PP(pp_rv2av)
const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV;
const svtype type = is_pp_rv2av ? SVt_PVAV : SVt_PVHV;
- if (!(PL_op->op_private & OPpDEREFed))
- SvGETMAGIC(sv);
+ SvGETMAGIC(sv);
if (SvROK(sv)) {
if (SvAMAGIC(sv)) {
sv = amagic_deref_call(sv, is_pp_rv2av ? to_av_amg : to_hv_amg);
@@ -1792,8 +1791,10 @@ PP(pp_helem)
else
SAVEHDELETE(hv, keysv);
}
- else if (PL_op->op_private & OPpDEREF)
- vivify_ref(*svp, PL_op->op_private & OPpDEREF);
+ else if (PL_op->op_private & OPpDEREF) {
+ PUSHs(vivify_ref(*svp, PL_op->op_private & OPpDEREF));
+ RETURN;
+ }
}
sv = (svp ? *svp : &PL_sv_undef);
/* Originally this did a conditional C<sv = sv_mortalcopy(sv)>; this
@@ -2463,14 +2464,12 @@ PP(pp_leavesub)
I32 gimme;
register PERL_CONTEXT *cx;
SV *sv;
- bool gmagic;
if (CxMULTICALL(&cxstack[cxstack_ix]))
return 0;
POPBLOCK(cx,newpm);
cxstack_ix++; /* temporarily protect top context */
- gmagic = CxLVAL(cx) & OPpENTERSUB_DEREF;
TAINT_NOT;
if (gimme == G_SCALAR) {
@@ -2481,7 +2480,6 @@ PP(pp_leavesub)
*MARK = SvREFCNT_inc(TOPs);
FREETMPS;
sv_2mortal(*MARK);
- if (gmagic) SvGETMAGIC(*MARK);
}
else {
sv = SvREFCNT_inc(TOPs); /* FREETMPS could clobber it */
@@ -2492,7 +2490,6 @@ PP(pp_leavesub)
}
else if (SvTEMP(TOPs) && SvREFCNT(TOPs) == 1) {
*MARK = TOPs;
- if (gmagic) SvGETMAGIC(TOPs);
}
else
*MARK = sv_mortalcopy(TOPs);
@@ -2842,8 +2839,10 @@ PP(pp_aelem)
else
SAVEADELETE(av, elem);
}
- else if (PL_op->op_private & OPpDEREF)
- vivify_ref(*svp, PL_op->op_private & OPpDEREF);
+ else if (PL_op->op_private & OPpDEREF) {
+ PUSHs(vivify_ref(*svp, PL_op->op_private & OPpDEREF));
+ RETURN;
+ }
}
sv = (svp ? *svp : &PL_sv_undef);
if (!lval && SvRMAGICAL(av) && SvGMAGICAL(sv)) /* see note in pp_helem() */
@@ -2852,7 +2851,7 @@ PP(pp_aelem)
RETURN;
}
-void
+SV*
Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
{
PERL_ARGS_ASSERT_VIVIFY_REF;
@@ -2876,6 +2875,14 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
SvROK_on(sv);
SvSETMAGIC(sv);
}
+ if (SvGMAGICAL(sv)) {
+ /* copy the sv without magic to prevent magic from being
+ executed twice */
+ SV* msv = sv_newmortal();
+ sv_setsv_nomg(msv, sv);
+ return msv;
+ }
+ return sv;
}
PP(pp_method)
diff --git a/proto.h b/proto.h
index 73f52c8680..7784a7a30e 100644
--- a/proto.h
+++ b/proto.h
@@ -4424,7 +4424,8 @@ PERL_CALLCONV void Perl_vivify_defelem(pTHX_ SV* sv)
#define PERL_ARGS_ASSERT_VIVIFY_DEFELEM \
assert(sv)
-PERL_CALLCONV void Perl_vivify_ref(pTHX_ SV* sv, U32 to_what)
+PERL_CALLCONV SV* Perl_vivify_ref(pTHX_ SV* sv, U32 to_what)
+ __attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_VIVIFY_REF \
assert(sv)
View Lorry Controller Status