/* pp.c
*
- * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
+ * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*/
/*
- * "It's a big house this, and very peculiar. Always a bit more to discover,
- * and no knowing what you'll find around a corner. And Elves, sir!" --Samwise
+ * 'It's a big house this, and very peculiar. Always a bit more
+ * to discover, and no knowing what you'll find round a corner.
+ * And Elves, sir!' --Samwise Gamgee
+ *
+ * [p.225 of _The Lord of the Rings_, II/i: "Many Meetings"]
*/
/* This file contains general pp ("push/pop") functions that execute the
}
gimme = GIMME_V;
if (gimme == G_ARRAY) {
- const I32 maxarg = AvFILL((AV*)TARG) + 1;
+ const I32 maxarg = AvFILL(MUTABLE_AV(TARG)) + 1;
EXTEND(SP, maxarg);
if (SvMAGICAL(TARG)) {
U32 i;
for (i=0; i < (U32)maxarg; i++) {
- SV * const * const svp = av_fetch((AV*)TARG, i, FALSE);
+ SV * const * const svp = av_fetch(MUTABLE_AV(TARG), i, FALSE);
SP[i+1] = (svp) ? *svp : &PL_sv_undef;
}
}
else {
- Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
+ Copy(AvARRAY((const AV *)TARG), SP+1, maxarg, SV*);
}
SP += maxarg;
}
else if (gimme == G_SCALAR) {
SV* const sv = sv_newmortal();
- const I32 maxarg = AvFILL((AV*)TARG) + 1;
+ const I32 maxarg = AvFILL(MUTABLE_AV(TARG)) + 1;
sv_setiv(sv, maxarg);
PUSHs(sv);
}
RETURNOP(do_kv());
}
else if (gimme == G_SCALAR) {
- SV* const sv = Perl_hv_scalar(aTHX_ (HV*)TARG);
+ SV* const sv = Perl_hv_scalar(aTHX_ MUTABLE_HV(TARG));
SETs(sv);
}
RETURN;
sv = SvRV(sv);
if (SvTYPE(sv) == SVt_PVIO) {
- GV * const gv = (GV*) sv_newmortal();
+ GV * const gv = MUTABLE_GV(sv_newmortal());
gv_init(gv, 0, "", 0, 0);
- GvIOp(gv) = (IO *)sv;
+ GvIOp(gv) = MUTABLE_IO(sv);
SvREFCNT_inc_void_NN(sv);
- sv = (SV*) gv;
+ sv = MUTABLE_SV(gv);
}
- else if (SvTYPE(sv) != SVt_PVGV)
+ else if (!isGV_with_GP(sv))
DIE(aTHX_ "Not a GLOB reference");
}
else {
- if (SvTYPE(sv) != SVt_PVGV) {
+ if (!isGV_with_GP(sv)) {
if (SvGMAGICAL(sv)) {
mg_get(sv);
if (SvROK(sv))
* NI-S 1999/05/07
*/
if (SvREADONLY(sv))
- Perl_croak(aTHX_ PL_no_modify);
+ Perl_croak(aTHX_ "%s", PL_no_modify);
if (PL_op->op_private & OPpDEREF) {
GV *gv;
if (cUNOP->op_targ) {
STRLEN len;
SV * const namesv = PAD_SV(cUNOP->op_targ);
const char * const name = SvPV(namesv, len);
- gv = (GV*)newSV(0);
+ gv = MUTABLE_GV(newSV(0));
gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
}
else {
gv = newGVgen(name);
}
prepare_SV_for_RV(sv);
- SvRV_set(sv, (SV*)gv);
+ SvRV_set(sv, MUTABLE_SV(gv));
SvROK_on(sv);
SvSETMAGIC(sv);
goto wasref;
if ((PL_op->op_flags & OPf_SPECIAL) &&
!(PL_op->op_flags & OPf_MOD))
{
- SV * const temp = (SV*)gv_fetchsv(sv, 0, SVt_PVGV);
+ SV * const temp = MUTABLE_SV(gv_fetchsv(sv, 0, SVt_PVGV));
if (!temp
&& (!is_gv_magical_sv(sv,0)
- || !(sv = (SV*)gv_fetchsv(sv, GV_ADD, SVt_PVGV)))) {
+ || !(sv = MUTABLE_SV(gv_fetchsv(sv, GV_ADD,
+ SVt_PVGV))))) {
RETSETUNDEF;
}
sv = temp;
things. */
RETURN;
}
- sv = (SV*)gv_fetchsv(sv, GV_ADD, SVt_PVGV);
+ sv = MUTABLE_SV(gv_fetchsv(sv, GV_ADD, SVt_PVGV));
}
}
}
if (PL_op->op_private & OPpLVAL_INTRO)
- save_gp((GV*)sv, !(PL_op->op_flags & OPf_SPECIAL));
+ save_gp(MUTABLE_GV(sv), !(PL_op->op_flags & OPf_SPECIAL));
SETs(sv);
RETURN;
}
}
}
else {
- gv = (GV*)sv;
+ gv = MUTABLE_GV(sv);
- if (SvTYPE(gv) != SVt_PVGV) {
+ if (!isGV_with_GP(gv)) {
if (SvGMAGICAL(sv)) {
mg_get(sv);
if (SvROK(sv))
if (PL_op->op_flags & OPf_MOD) {
if (PL_op->op_private & OPpLVAL_INTRO) {
if (cUNOP->op_first->op_type == OP_NULL)
- sv = save_scalar((GV*)TOPs);
+ sv = save_scalar(MUTABLE_GV(TOPs));
else if (gv)
sv = save_scalar(gv);
else
- Perl_croak(aTHX_ PL_no_localize_ref);
+ Perl_croak(aTHX_ "%s", PL_no_localize_ref);
}
else if (PL_op->op_private & OPpDEREF)
vivify_ref(sv, PL_op->op_private & OPpDEREF);
PP(pp_av2arylen)
{
dVAR; dSP;
- AV * const av = (AV*)TOPs;
- SV ** const sv = Perl_av_arylen_p(aTHX_ (AV*)av);
+ AV * const av = MUTABLE_AV(TOPs);
+ SV ** const sv = Perl_av_arylen_p(aTHX_ MUTABLE_AV(av));
if (!*sv) {
*sv = newSV_type(SVt_PVMG);
- sv_magic(*sv, (SV*)av, PERL_MAGIC_arylen, NULL, 0);
+ sv_magic(*sv, MUTABLE_SV(av), PERL_MAGIC_arylen, NULL, 0);
}
SETs(*sv);
RETURN;
CV *cv = sv_2cv(TOPs, &stash_unused, &gv, flags);
if (cv) {
if (CvCLONE(cv))
- cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
+ cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
if ((PL_op->op_private & OPpLVAL_INTRO)) {
if (gv && GvCV(gv) == cv && (gv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), FALSE)))
cv = GvCV(gv);
}
}
else if ((flags == (GV_ADD|GV_NOEXPAND)) && gv && SvROK(gv)) {
- cv = (CV*)gv;
+ cv = MUTABLE_CV(gv);
}
else
- cv = (CV*)&PL_sv_undef;
- SETs((SV*)cv);
+ cv = MUTABLE_CV(&PL_sv_undef);
+ SETs(MUTABLE_SV(cv));
RETURN;
}
PP(pp_anoncode)
{
dVAR; dSP;
- CV* cv = (CV*)PAD_SV(PL_op->op_targ);
+ CV *cv = MUTABLE_CV(PAD_SV(PL_op->op_targ));
if (CvCLONE(cv))
- cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
+ cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
EXTEND(SP,1);
- PUSHs((SV*)cv);
+ PUSHs(MUTABLE_SV(cv));
RETURN;
}
SvREFCNT_inc_void_NN(sv);
}
else if (SvTYPE(sv) == SVt_PVAV) {
- if (!AvREAL((AV*)sv) && AvREIFY((AV*)sv))
- av_reify((AV*)sv);
+ if (!AvREAL((const AV *)sv) && AvREIFY((const AV *)sv))
+ av_reify(MUTABLE_AV(sv));
SvTEMP_off(sv);
SvREFCNT_inc_void_NN(sv);
}
SV *sv = POPs;
const char * const elem = SvPV_nolen_const(sv);
- GV * const gv = (GV*)POPs;
+ GV * const gv = MUTABLE_GV(POPs);
SV * tmpRef = NULL;
sv = NULL;
switch (*elem) {
case 'A':
if (strEQ(second_letter, "RRAY"))
- tmpRef = (SV*)GvAV(gv);
+ tmpRef = MUTABLE_SV(GvAV(gv));
break;
case 'C':
if (strEQ(second_letter, "ODE"))
- tmpRef = (SV*)GvCVu(gv);
+ tmpRef = MUTABLE_SV(GvCVu(gv));
break;
case 'F':
if (strEQ(second_letter, "ILEHANDLE")) {
/* finally deprecated in 5.8.0 */
deprecate("*glob{FILEHANDLE}");
- tmpRef = (SV*)GvIOp(gv);
+ tmpRef = MUTABLE_SV(GvIOp(gv));
}
else
if (strEQ(second_letter, "ORMAT"))
- tmpRef = (SV*)GvFORM(gv);
+ tmpRef = MUTABLE_SV(GvFORM(gv));
break;
case 'G':
if (strEQ(second_letter, "LOB"))
- tmpRef = (SV*)gv;
+ tmpRef = MUTABLE_SV(gv);
break;
case 'H':
if (strEQ(second_letter, "ASH"))
- tmpRef = (SV*)GvHV(gv);
+ tmpRef = MUTABLE_SV(GvHV(gv));
break;
case 'I':
if (*second_letter == 'O' && !elem[2])
- tmpRef = (SV*)GvIOp(gv);
+ tmpRef = MUTABLE_SV(GvIOp(gv));
break;
case 'N':
if (strEQ(second_letter, "AME"))
case SVt_NULL:
break;
case SVt_PVAV:
- av_undef((AV*)sv);
+ av_undef(MUTABLE_AV(sv));
break;
case SVt_PVHV:
- hv_undef((HV*)sv);
+ hv_undef(MUTABLE_HV(sv));
break;
case SVt_PVCV:
- if (cv_const_sv((CV*)sv) && ckWARN(WARN_MISC))
+ if (cv_const_sv((const CV *)sv) && ckWARN(WARN_MISC))
Perl_warner(aTHX_ packWARN(WARN_MISC), "Constant subroutine %s undefined",
- CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
+ CvANON((const CV *)sv) ? "(anonymous)"
+ : GvENAME(CvGV((const CV *)sv)));
/* FALLTHROUGH */
case SVt_PVFM:
{
/* let user-undef'd sub keep its identity */
- GV* const gv = CvGV((CV*)sv);
- cv_undef((CV*)sv);
- CvGV((CV*)sv) = gv;
+ GV* const gv = CvGV((const CV *)sv);
+ cv_undef(MUTABLE_CV(sv));
+ CvGV((const CV *)sv) = gv;
}
break;
case SVt_PVGV:
- if (SvFAKE(sv))
+ if (SvFAKE(sv)) {
SvSetMagicSV(sv, &PL_sv_undef);
- else {
+ break;
+ }
+ else if (isGV_with_GP(sv)) {
GP *gp;
HV *stash;
/* undef *Foo:: */
- if((stash = GvHV((GV*)sv)) && HvNAME_get(stash))
+ if((stash = GvHV((const GV *)sv)) && HvNAME_get(stash))
mro_isa_changed_in(stash);
/* undef *Pkg::meth_name ... */
- else if(GvCVu((GV*)sv) && (stash = GvSTASH((GV*)sv)) && HvNAME_get(stash))
+ else if(GvCVu((const GV *)sv) && (stash = GvSTASH((const GV *)sv))
+ && HvNAME_get(stash))
mro_method_changed_in(stash);
- gp_free((GV*)sv);
+ gp_free(MUTABLE_GV(sv));
Newxz(gp, 1, GP);
GvGP(sv) = gp_ref(gp);
GvSV(sv) = newSV(0);
GvLINE(sv) = CopLINE(PL_curcop);
- GvEGV(sv) = (GV*)sv;
+ GvEGV(sv) = MUTABLE_GV(sv);
GvMULTI_on(sv);
+ break;
}
- break;
+ /* FALL THROUGH */
default:
if (SvTYPE(sv) >= SVt_PV && SvPVX_const(sv) && SvLEN(sv)) {
SvPV_free(sv);
PP(pp_predec)
{
dVAR; dSP;
- if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
- DIE(aTHX_ PL_no_modify);
+ if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
+ DIE(aTHX_ "%s", PL_no_modify);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MIN)
{
PP(pp_postinc)
{
dVAR; dSP; dTARGET;
- if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
- DIE(aTHX_ PL_no_modify);
+ if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
+ DIE(aTHX_ "%s", PL_no_modify);
sv_setsv(TARG, TOPs);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MAX)
PP(pp_postdec)
{
dVAR; dSP; dTARGET;
- if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
- DIE(aTHX_ PL_no_modify);
+ if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
+ DIE(aTHX_ "%s", PL_no_modify);
sv_setsv(TARG, TOPs);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MIN)
}
MARK++;
repeatcpy((char*)(MARK + items), (char*)MARK,
- items * sizeof(SV*), count - 1);
+ items * sizeof(const SV *), count - 1);
SP += max;
}
else if (count <= 0)
STRLEN len;
const char * const s = SvPV_const(sv, len);
if (isIDFIRST(*s)) {
- sv_setpvn(TARG, "-", 1);
+ sv_setpvs(TARG, "-");
sv_catsv(TARG, sv);
}
else if (*s == '+' || *s == '-') {
if (SvNOK(sv))
sv_setnv(TARG, -SvNV(sv));
else {
- sv_setpvn(TARG, "-", 1);
+ sv_setpvs(TARG, "-");
sv_catsv(TARG, sv);
}
}
sv_usepvn_flags(TARG, (char*)result, nchar, SV_HAS_TRAILING_NUL);
SvUTF8_off(TARG);
}
- SETs(TARG);
+ SETTARG;
RETURN;
}
#ifdef LIBERAL
#endif
for ( ; anum > 0; anum--, tmps++)
*tmps = ~*tmps;
-
- SETs(TARG);
+ SETTARG;
}
RETURN;
}
}
if (!SvOK(sv))
sv_setpvs(sv, "");
- sv_insert(sv, pos, rem, repl, repl_len);
+ sv_insert_flags(sv, pos, rem, repl, repl_len, 0);
if (repl_is_utf8)
SvUTF8_on(sv);
if (repl_sv_copy)
# else
sv_setpv(TARG, PerlProc_crypt(tmps, SvPV_nolen_const(right)));
# endif
- SETs(TARG);
+ SETTARG;
RETURN;
#else
DIE(aTHX_
}
else
sv_setpvn(TARG, s, len);
- SETs(TARG);
- if (SvSMAGICAL(TARG))
- mg_set(TARG);
+ SETTARG;
RETURN;
}
PP(pp_aslice)
{
dVAR; dSP; dMARK; dORIGMARK;
- register AV* const av = (AV*)POPs;
+ register AV *const av = MUTABLE_AV(POPs);
register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
if (SvTYPE(av) == SVt_PVAV) {
const I32 arybase = CopARYBASE_get(PL_curcop);
- if (lval && PL_op->op_private & OPpLVAL_INTRO) {
+ const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
+ bool can_preserve = FALSE;
+
+ if (localizing) {
+ MAGIC *mg;
+ HV *stash;
+
+ can_preserve = SvCANEXISTDELETE(av);
+ }
+
+ if (lval && localizing) {
register SV **svp;
I32 max = -1;
for (svp = MARK + 1; svp <= SP; svp++) {
if (max > AvMAX(av))
av_extend(av, max);
}
+
while (++MARK <= SP) {
register SV **svp;
I32 elem = SvIV(*MARK);
+ bool preeminent = TRUE;
if (elem > 0)
elem -= arybase;
+ if (localizing && can_preserve) {
+ /* If we can determine whether the element exist,
+ * Try to preserve the existenceness of a tied array
+ * element by using EXISTS and DELETE if possible.
+ * Fallback to FETCH and STORE otherwise. */
+ preeminent = av_exists(av, elem);
+ }
+
svp = av_fetch(av, elem, lval);
if (lval) {
if (!svp || *svp == &PL_sv_undef)
DIE(aTHX_ PL_no_aelem, elem);
- if (PL_op->op_private & OPpLVAL_INTRO)
- save_aelem(av, elem, svp);
+ if (localizing) {
+ if (preeminent)
+ save_aelem(av, elem, svp);
+ else
+ SAVEADELETE(av, elem);
+ }
}
*MARK = svp ? *svp : &PL_sv_undef;
}
{
dVAR;
dSP;
- AV *array = (AV*)POPs;
+ AV *array = MUTABLE_AV(POPs);
const I32 gimme = GIMME_V;
IV *iterp = Perl_av_iter_p(aTHX_ array);
const IV current = (*iterp)++;
{
dVAR;
dSP;
- AV *array = (AV*)POPs;
+ AV *array = MUTABLE_AV(POPs);
const I32 gimme = GIMME_V;
*Perl_av_iter_p(aTHX_ array) = 0;
{
dVAR;
dSP;
- HV * hash = (HV*)POPs;
+ HV * hash = MUTABLE_HV(POPs);
HE *entry;
const I32 gimme = GIMME_V;
if (PL_op->op_private & OPpSLICE) {
dMARK; dORIGMARK;
- HV * const hv = (HV*)POPs;
+ HV * const hv = MUTABLE_HV(POPs);
const U32 hvtype = SvTYPE(hv);
if (hvtype == SVt_PVHV) { /* hash element */
while (++MARK <= SP) {
else if (hvtype == SVt_PVAV) { /* array element */
if (PL_op->op_flags & OPf_SPECIAL) {
while (++MARK <= SP) {
- SV * const sv = av_delete((AV*)hv, SvIV(*MARK), discard);
+ SV * const sv = av_delete(MUTABLE_AV(hv), SvIV(*MARK), discard);
*MARK = sv ? sv : &PL_sv_undef;
}
}
}
else {
SV *keysv = POPs;
- HV * const hv = (HV*)POPs;
+ HV * const hv = MUTABLE_HV(POPs);
SV *sv;
if (SvTYPE(hv) == SVt_PVHV)
sv = hv_delete_ent(hv, keysv, discard, 0);
else if (SvTYPE(hv) == SVt_PVAV) {
if (PL_op->op_flags & OPf_SPECIAL)
- sv = av_delete((AV*)hv, SvIV(keysv), discard);
+ sv = av_delete(MUTABLE_AV(hv), SvIV(keysv), discard);
else
DIE(aTHX_ "panic: avhv_delete no longer supported");
}
RETPUSHNO;
}
tmpsv = POPs;
- hv = (HV*)POPs;
+ hv = MUTABLE_HV(POPs);
if (SvTYPE(hv) == SVt_PVHV) {
if (hv_exists_ent(hv, tmpsv, 0))
RETPUSHYES;
}
else if (SvTYPE(hv) == SVt_PVAV) {
if (PL_op->op_flags & OPf_SPECIAL) { /* array element */
- if (av_exists((AV*)hv, SvIV(tmpsv)))
+ if (av_exists(MUTABLE_AV(hv), SvIV(tmpsv)))
RETPUSHYES;
}
}
PP(pp_hslice)
{
dVAR; dSP; dMARK; dORIGMARK;
- register HV * const hv = (HV*)POPs;
+ register HV * const hv = MUTABLE_HV(POPs);
register const I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
- bool other_magic = FALSE;
+ bool can_preserve = FALSE;
if (localizing) {
MAGIC *mg;
HV *stash;
- other_magic = mg_find((SV*)hv, PERL_MAGIC_env) ||
- ((mg = mg_find((SV*)hv, PERL_MAGIC_tied))
- /* Try to preserve the existenceness of a tied hash
- * element by using EXISTS and DELETE if possible.
- * Fallback to FETCH and STORE otherwise */
- && (stash = SvSTASH(SvRV(SvTIED_obj((SV*)hv, mg))))
- && gv_fetchmethod_autoload(stash, "EXISTS", TRUE)
- && gv_fetchmethod_autoload(stash, "DELETE", TRUE));
+ if (SvCANEXISTDELETE(hv) || mg_find((const SV *)hv, PERL_MAGIC_env))
+ can_preserve = TRUE;
}
while (++MARK <= SP) {
SV * const keysv = *MARK;
SV **svp;
HE *he;
- bool preeminent = FALSE;
-
- if (localizing) {
- preeminent = SvRMAGICAL(hv) && !other_magic ? 1 :
- hv_exists_ent(hv, keysv, 0);
+ bool preeminent = TRUE;
+
+ if (localizing && can_preserve) {
+ /* If we can determine whether the element exist,
+ * try to preserve the existenceness of a tied hash
+ * element by using EXISTS and DELETE if possible.
+ * Fallback to FETCH and STORE otherwise. */
+ preeminent = hv_exists_ent(hv, keysv, 0);
}
he = hv_fetch_ent(hv, keysv, lval, 0);
}
if (localizing) {
if (HvNAME_get(hv) && isGV(*svp))
- save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL));
+ save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL));
else {
if (preeminent)
- save_helem(hv, keysv, svp);
+ save_helem_flags(hv, keysv, svp,
+ (PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC);
else {
STRLEN keylen;
const char * const key = SvPV_const(keysv, keylen);
{
dVAR; dSP; dMARK; dORIGMARK;
const I32 items = SP - MARK;
- SV * const av = (SV *) av_make(items, MARK+1);
+ SV * const av = MUTABLE_SV(av_make(items, MARK+1));
SP = ORIGMARK; /* av_make() might realloc stack_sp */
mXPUSHs((PL_op->op_flags & OPf_SPECIAL)
? newRV_noinc(av) : av);
}
SP = ORIGMARK;
mXPUSHs((PL_op->op_flags & OPf_SPECIAL)
- ? newRV_noinc((SV*) hv) : (SV*) hv);
+ ? newRV_noinc(MUTABLE_SV(hv)) : MUTABLE_SV(hv));
RETURN;
}
PP(pp_splice)
{
dVAR; dSP; dMARK; dORIGMARK;
- register AV *ary = (AV*)*++MARK;
+ register AV *ary = MUTABLE_AV(*++MARK);
register SV **src;
register SV **dst;
register I32 i;
I32 newlen;
I32 after;
I32 diff;
- const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied);
+ const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied);
if (mg) {
- *MARK-- = SvTIED_obj((SV*)ary, mg);
+ *MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg);
PUSHMARK(MARK);
PUTBACK;
ENTER;
PP(pp_push)
{
dVAR; dSP; dMARK; dORIGMARK; dTARGET;
- register AV * const ary = (AV*)*++MARK;
- const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied);
+ register AV * const ary = MUTABLE_AV(*++MARK);
+ const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied);
if (mg) {
- *MARK-- = SvTIED_obj((SV*)ary, mg);
+ *MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg);
PUSHMARK(MARK);
PUTBACK;
ENTER;
LEAVE;
SPAGAIN;
SP = ORIGMARK;
- PUSHi( AvFILL(ary) + 1 );
+ if (GIMME_V != G_VOID) {
+ PUSHi( AvFILL(ary) + 1 );
+ }
}
else {
PL_delaymagic = DM_DELAY;
av_store(ary, AvFILLp(ary)+1, sv);
}
if (PL_delaymagic & DM_ARRAY)
- mg_set((SV*)ary);
+ mg_set(MUTABLE_SV(ary));
PL_delaymagic = 0;
SP = ORIGMARK;
{
dVAR;
dSP;
- AV * const av = (AV*)POPs;
+ AV * const av = MUTABLE_AV(POPs);
SV * const sv = PL_op->op_type == OP_SHIFT ? av_shift(av) : av_pop(av);
EXTEND(SP, 1);
assert (sv);
PP(pp_unshift)
{
dVAR; dSP; dMARK; dORIGMARK; dTARGET;
- register AV *ary = (AV*)*++MARK;
- const MAGIC * const mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied);
+ register AV *ary = MUTABLE_AV(*++MARK);
+ const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied);
if (mg) {
- *MARK-- = SvTIED_obj((SV*)ary, mg);
+ *MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg);
PUSHMARK(MARK);
PUTBACK;
ENTER;
}
}
SP = ORIGMARK;
- PUSHi( AvFILL(ary) + 1 );
+ if (GIMME_V != G_VOID) {
+ PUSHi( AvFILL(ary) + 1 );
+ }
RETURN;
}
SvUTF8_off(TARG); /* decontaminate */
if (SP - MARK > 1)
do_join(TARG, &PL_sv_no, MARK, SP);
- else
+ else {
sv_setsv(TARG, (SP > MARK)
? *SP
: (padoff_du = find_rundefsvoffset(),
(padoff_du == NOT_IN_PAD
|| PAD_COMPNAME_FLAGS_isOUR(padoff_du))
? DEFSV : PAD_SVl(padoff_du)));
+
+ if (! SvOK(TARG) && ckWARN(WARN_UNINITIALIZED))
+ report_uninit(TARG);
+ }
+
up = SvPV_force(TARG, len);
if (len > 1) {
if (DO_UTF8(TARG)) { /* first reverse each character */
#ifdef USE_ITHREADS
if (pm->op_pmreplrootu.op_pmtargetoff) {
- ary = GvAVn((GV*)PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff));
+ ary = GvAVn(MUTABLE_GV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff)));
}
#else
if (pm->op_pmreplrootu.op_pmtargetgv) {
av_extend(ary,0);
av_clear(ary);
SPAGAIN;
- if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
+ if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) {
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)ary, mg));
+ XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg));
}
else {
if (!AvREAL(ary)) {
if (!mg) {
if (SvSMAGICAL(ary)) {
PUTBACK;
- mg_set((SV*)ary);
+ mg_set(MUTABLE_SV(ary));
SPAGAIN;
}
if (gimme == G_ARRAY) {
dSP;
dTOPss;
SV *retsv = sv;
+ assert(SvTYPE(retsv) != SVt_PVCV);
SvLOCK(sv);
- if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
- || SvTYPE(retsv) == SVt_PVCV) {
+ if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV) {
retsv = refto(retsv);
}
SETs(retsv);
https://perl5.git.perl.org / perl5.git / blobdiff