PP(pp_sassign)
{
dVAR; dSP; dPOPTOPssrl;
+ U32 wasfake = 0;
if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
SV * const temp = left;
}
}
+ /* Allow glob assignments like *$x = ..., which, when the glob has a
+ SVf_FAKE flag, cannot be distinguished from $x = ... without looking
+ at the op tree. */
+ if( SvTYPE(right) == SVt_PVGV && cBINOP->op_last->op_type == OP_RV2GV
+ && (wasfake = SvFLAGS(right) & SVf_FAKE) )
+ SvFLAGS(right) &= ~SVf_FAKE;
SvSetMagicSV(right, left);
+ if(wasfake) SvFLAGS(right) |= SVf_FAKE;
SETs(right);
RETURN;
}
rcopied = TRUE;
}
- if (TARG != left) {
+ if (TARG != left) { /* not $l .= $r */
STRLEN llen;
const char* const lpv = SvPV_nomg_const(left, llen);
lbyte = !DO_UTF8(left);
else
SvUTF8_off(TARG);
}
- else { /* TARG == left */
- STRLEN llen;
+ else { /* $l .= $r */
if (!SvOK(TARG)) {
- if (left == right && ckWARN(WARN_UNINITIALIZED))
+ if (left == right && ckWARN(WARN_UNINITIALIZED)) /* $l .= $l */
report_uninit(right);
sv_setpvs(left, "");
}
- (void)SvPV_nomg_const(left, llen); /* Needed to set UTF8 flag */
- lbyte = !DO_UTF8(left);
+ lbyte = (SvROK(left) && SvTYPE(SvRV(left)) == SVt_REGEXP)
+ ? !DO_UTF8(SvRV(left)) : !DO_UTF8(left);
if (IN_BYTES)
SvUTF8_off(TARG);
}
if (!rcopied) {
if (left == right)
- /* $a.$a: do magic twice: tied might return different 2nd time */
+ /* $r.$r: do magic twice: tied might return different 2nd time */
SvGETMAGIC(right);
rpv = SvPV_nomg_const(right, rlen);
rbyte = !DO_UTF8(right);
{
dVAR; dSP;
if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
- DIE(aTHX_ "%s", PL_no_modify);
+ Perl_croak_no_modify(aTHX);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MAX)
{
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);
if (SvROK(sv)) {
- wasref:
tryAMAGICunDEREF_var(is_pp_rv2av ? to_av_amg : to_hv_amg);
sv = SvRV(sv);
GV *gv;
if (!isGV_with_GP(sv)) {
- if (SvGMAGICAL(sv)) {
- mg_get(sv);
- if (SvROK(sv))
- goto wasref;
- }
gv = Perl_softref2xv(aTHX_ sv, is_pp_rv2av ? an_array : a_hash,
type, &sp);
if (!gv)
*(relem++) = sv;
didstore = av_store(ary,i++,sv);
if (magic) {
- if (SvSMAGICAL(sv)) {
- /* More magic can happen in the mg_set callback, so we
- * backup the delaymagic for now. */
- U16 dmbak = PL_delaymagic;
- PL_delaymagic = 0;
+ if (SvSMAGICAL(sv))
mg_set(sv);
- PL_delaymagic = dmbak;
- }
if (!didstore)
sv_2mortal(sv);
}
TAINT_NOT;
}
- if (PL_delaymagic & DM_ARRAY)
+ if (PL_delaymagic & DM_ARRAY_ISA)
SvSETMAGIC(MUTABLE_SV(ary));
break;
case SVt_PVHV: { /* normal hash */
duplicates += 2;
didstore = hv_store_ent(hash,sv,tmpstr,0);
if (magic) {
- if (SvSMAGICAL(tmpstr)) {
- U16 dmbak = PL_delaymagic;
- PL_delaymagic = 0;
+ if (SvSMAGICAL(tmpstr))
mg_set(tmpstr);
- PL_delaymagic = dmbak;
- }
if (!didstore)
sv_2mortal(tmpstr);
}
}
else
sv_setsv(sv, &PL_sv_undef);
-
- if (SvSMAGICAL(sv)) {
- U16 dmbak = PL_delaymagic;
- PL_delaymagic = 0;
- mg_set(sv);
- PL_delaymagic = dmbak;
- }
+ SvSETMAGIC(sv);
break;
}
}
SvROK_on(rv);
if (pkg) {
- HV* const stash = gv_stashpv(SvPV_nolen(pkg), GV_ADD);
+ HV *const stash = gv_stashsv(pkg, GV_ADD);
SvREFCNT_dec(pkg);
(void)sv_bless(rv, stash);
}
}
SvUPGRADE(sv, SVt_PV);
tmplen = SvLEN(sv); /* remember if already alloced */
- if (!tmplen && !SvREADONLY(sv))
- Sv_Grow(sv, 80); /* try short-buffering it */
+ if (!tmplen && !SvREADONLY(sv)) {
+ /* try short-buffering it. Please update t/op/readline.t
+ * if you change the growth length.
+ */
+ Sv_Grow(sv, 80);
+ }
offset = 0;
if (type == OP_RCATLINE && SvOK(sv)) {
if (!SvPOK(sv)) {
|| ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
|| SvTYPE(TARG) > SVt_PVLV)
&& !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
- DIE(aTHX_ "%s", PL_no_modify);
+ Perl_croak_no_modify(aTHX);
PUTBACK;
setup_match:
if (MARK == SP) {
/* Temporaries are bad unless they happen to be elements
* of a tied hash or array */
- if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY) &&
+ if ((SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP) ||
+ (SvFLAGS(TOPs) & (SVf_READONLY | SVf_FAKE))
+ == SVf_READONLY
+ ) &&
!(SvRMAGICAL(TOPs) && mg_find(TOPs, PERL_MAGIC_tiedelem))) {
LEAVE;
cxstack_ix--;
}
break;
default:
- if (!SvROK(sv)) {
+ if (sv == &PL_sv_yes) { /* unfound import, ignore */
+ if (hasargs)
+ SP = PL_stack_base + POPMARK;
+ RETURN;
+ }
+ SvGETMAGIC(sv);
+ if (SvROK(sv)) {
+ SV * const * sp = &sv; /* Used in tryAMAGICunDEREF macro. */
+ tryAMAGICunDEREF(to_cv);
+ }
+ else {
const char *sym;
STRLEN len;
- if (sv == &PL_sv_yes) { /* unfound import, ignore */
- if (hasargs)
- SP = PL_stack_base + POPMARK;
- RETURN;
- }
- if (SvGMAGICAL(sv)) {
- mg_get(sv);
- if (SvROK(sv))
- goto got_rv;
- if (SvPOKp(sv)) {
- sym = SvPVX_const(sv);
- len = SvCUR(sv);
- } else {
- sym = NULL;
- len = 0;
- }
- }
- else {
- sym = SvPV_const(sv, len);
- }
+ sym = SvPV_nomg_const(sv, len);
if (!sym)
DIE(aTHX_ PL_no_usym, "a subroutine");
if (PL_op->op_private & HINT_STRICT_REFS)
cv = get_cvn_flags(sym, len, GV_ADD|SvUTF8(sv));
break;
}
- got_rv:
- {
- SV * const * sp = &sv; /* Used in tryAMAGICunDEREF macro. */
- tryAMAGICunDEREF(to_cv);
- }
cv = MUTABLE_CV(SvRV(sv));
if (SvTYPE(cv) == SVt_PVCV)
break;
SvGETMAGIC(sv);
if (!SvOK(sv)) {
if (SvREADONLY(sv))
- Perl_croak(aTHX_ "%s", PL_no_modify);
+ Perl_croak_no_modify(aTHX);
prepare_SV_for_RV(sv);
switch (to_what) {
case OPpDEREF_SV:
https://perl5.git.perl.org / perl5.git / blobdiff