{
dVAR; dSP; dTOPss;
- SvGETMAGIC(sv);
+ if (!isGV(sv) || SvFAKE(sv)) SvGETMAGIC(sv);
if (SvROK(sv)) {
wasref:
- tryAMAGICunDEREF(to_gv);
+ sv = amagic_deref_call(sv, to_gv_amg);
+ SPAGAIN;
sv = SvRV(sv);
if (SvTYPE(sv) == SVt_PVIO) {
* NI-S 1999/05/07
*/
if (SvREADONLY(sv))
- Perl_croak(aTHX_ "%s", PL_no_modify);
+ Perl_croak_no_modify(aTHX);
if (PL_op->op_private & OPpDEREF) {
GV *gv;
if (cUNOP->op_targ) {
}
sv = MUTABLE_SV(gv_fetchsv(sv, GV_ADD, SVt_PVGV));
}
+ /* FAKE globs in the symbol table cause weird bugs (#77810) */
+ if (sv) SvFAKE_off(sv);
}
}
if (PL_op->op_private & OPpLVAL_INTRO)
save_gp(MUTABLE_GV(sv), !(PL_op->op_flags & OPf_SPECIAL));
- SETs(sv);
+ if (sv && SvFAKE(sv)) {
+ SV *newsv = sv_newmortal();
+ sv_setsv_flags(newsv, sv, 0);
+ SvFAKE_off(newsv);
+ SETs(newsv);
+ }
+ else SETs(sv);
RETURN;
}
dVAR; dSP; dTOPss;
GV *gv = NULL;
- SvGETMAGIC(sv);
+ if (!(PL_op->op_private & OPpDEREFed))
+ SvGETMAGIC(sv);
if (SvROK(sv)) {
- tryAMAGICunDEREF(to_sv);
+ sv = amagic_deref_call(sv, to_sv_amg);
+ SPAGAIN;
sv = SvRV(sv);
switch (SvTYPE(sv)) {
PP(pp_pos)
{
- dVAR; dSP; dTARGET; dPOPss;
+ dVAR; dSP; dPOPss;
if (PL_op->op_flags & OPf_MOD || LVRET) {
- if (SvTYPE(TARG) < SVt_PVLV) {
- sv_upgrade(TARG, SVt_PVLV);
- sv_magic(TARG, NULL, PERL_MAGIC_pos, NULL, 0);
- }
-
- LvTYPE(TARG) = '.';
- if (LvTARG(TARG) != sv) {
- SvREFCNT_dec(LvTARG(TARG));
- LvTARG(TARG) = SvREFCNT_inc_simple(sv);
- }
- PUSHs(TARG); /* no SvSETMAGIC */
+ SV * const ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */
+ sv_magic(ret, NULL, PERL_MAGIC_pos, NULL, 0);
+ LvTYPE(ret) = '.';
+ LvTARG(ret) = SvREFCNT_inc_simple(sv);
+ PUSHs(ret); /* no SvSETMAGIC */
RETURN;
}
else {
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
const MAGIC * const mg = mg_find(sv, PERL_MAGIC_regex_global);
if (mg && mg->mg_len >= 0) {
+ dTARGET;
I32 i = mg->mg_len;
if (DO_UTF8(sv))
sv_pos_b2u(sv, &i);
goto set;
}
if (code == -KEY_keys || code == -KEY_values || code == -KEY_each) {
- ret = newSVpvs_flags("\\[@%]", SVs_TEMP);
+ ret = newSVpvs_flags("+", SVs_TEMP);
+ goto set;
+ }
+ if (code == -KEY_push || code == -KEY_unshift) {
+ ret = newSVpvs_flags("+@", SVs_TEMP);
+ goto set;
+ }
+ if (code == -KEY_pop || code == -KEY_shift) {
+ ret = newSVpvs_flags(";+", SVs_TEMP);
+ goto set;
+ }
+ if (code == -KEY_splice) {
+ ret = newSVpvs_flags("+;$$@", SVs_TEMP);
+ goto set;
+ }
+ if (code == -KEY_tied || code == -KEY_untie) {
+ ret = newSVpvs_flags("\\[$@%*]", SVs_TEMP);
+ goto set;
+ }
+ if (code == -KEY_tie) {
+ ret = newSVpvs_flags("\\[$@%*]$@", SVs_TEMP);
goto set;
}
if (code == -KEY_readpipe) {
EXTEND(SP,1);
}
TARG = sv_newmortal();
- PUSHi(do_trans(sv));
+ if(PL_op->op_type == OP_TRANSR) {
+ SV * const newsv = newSVsv(sv);
+ do_trans(newsv);
+ mPUSHs(newsv);
+ }
+ else PUSHi(do_trans(sv));
RETURN;
}
/* let user-undef'd sub keep its identity */
GV* const gv = CvGV((const CV *)sv);
cv_undef(MUTABLE_CV(sv));
- CvGV((const CV *)sv) = gv;
+ CvGV_set(MUTABLE_CV(sv), gv);
}
break;
case SVt_PVGV:
GP *gp;
HV *stash;
- /* undef *Foo:: */
- if((stash = GvHV((const GV *)sv)) && HvNAME_get(stash))
- mro_isa_changed_in(stash);
/* undef *Pkg::meth_name ... */
- else if(GvCVu((const GV *)sv) && (stash = GvSTASH((const GV *)sv))
- && HvNAME_get(stash))
- mro_method_changed_in(stash);
+ bool method_changed
+ = GvCVu((const GV *)sv) && (stash = GvSTASH((const GV *)sv))
+ && HvENAME_get(stash);
+ /* undef *Foo:: */
+ if((stash = GvHV((const GV *)sv))) {
+ if(HvENAME_get(stash))
+ SvREFCNT_inc_simple_void_NN(sv_2mortal((SV *)stash));
+ else stash = NULL;
+ }
gp_free(MUTABLE_GV(sv));
Newxz(gp, 1, GP);
GvLINE(sv) = CopLINE(PL_curcop);
GvEGV(sv) = MUTABLE_GV(sv);
GvMULTI_on(sv);
+
+ if(stash)
+ mro_package_moved(NULL, stash, (const GV *)sv, NULL, 0);
+ stash = NULL;
+ /* undef *Foo::ISA */
+ if( strEQ(GvNAME((const GV *)sv), "ISA")
+ && (stash = GvSTASH((const GV *)sv))
+ && (method_changed || HvENAME(stash)) )
+ mro_isa_changed_in(stash);
+ else if(method_changed)
+ mro_method_changed_in(
+ GvSTASH((const GV *)sv)
+ );
+
break;
}
/* FALL THROUGH */
{
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_MIN)
{
{
dVAR; dSP; dTARGET;
if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
- DIE(aTHX_ "%s", PL_no_modify);
+ Perl_croak_no_modify(aTHX);
+ if (SvROK(TOPs))
+ TARG = sv_newmortal();
sv_setsv(TARG, TOPs);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MAX)
{
dVAR; dSP; dTARGET;
if (SvTYPE(TOPs) >= SVt_PVAV || isGV_with_GP(TOPs))
- DIE(aTHX_ "%s", PL_no_modify);
+ Perl_croak_no_modify(aTHX);
+ if (SvROK(TOPs))
+ TARG = sv_newmortal();
sv_setsv(TARG, TOPs);
if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != IV_MIN)
{
dPOPTOPssrl;
const int cmp = (IN_LOCALE_RUNTIME
- ? sv_cmp_locale(left, right)
- : sv_cmp(left, right));
+ ? sv_cmp_locale_flags(left, right, 0)
+ : sv_cmp_flags(left, right, 0));
SETs(boolSV(cmp * multiplier < rhs));
RETURN;
}
tryAMAGICbin_MG(seq_amg, AMGf_set);
{
dPOPTOPssrl;
- SETs(boolSV(sv_eq(left, right)));
+ SETs(boolSV(sv_eq_flags(left, right, 0)));
RETURN;
}
}
tryAMAGICbin_MG(sne_amg, AMGf_set);
{
dPOPTOPssrl;
- SETs(boolSV(!sv_eq(left, right)));
+ SETs(boolSV(!sv_eq_flags(left, right, 0)));
RETURN;
}
}
{
dPOPTOPssrl;
const int cmp = (IN_LOCALE_RUNTIME
- ? sv_cmp_locale(left, right)
- : sv_cmp(left, right));
+ ? sv_cmp_locale_flags(left, right, 0)
+ : sv_cmp_flags(left, right, 0));
SETi( cmp );
RETURN;
}
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
+ const bool left_ro_nonnum = !SvNIOKp(left) && SvREADONLY(left);
+ const bool right_ro_nonnum = !SvNIOKp(right) && SvREADONLY(right);
if (PL_op->op_private & HINT_INTEGER) {
const IV i = SvIV_nomg(left) & SvIV_nomg(right);
SETi(i);
const UV u = SvUV_nomg(left) & SvUV_nomg(right);
SETu(u);
}
+ if (left_ro_nonnum) SvNIOK_off(left);
+ if (right_ro_nonnum) SvNIOK_off(right);
}
else {
do_vop(PL_op->op_type, TARG, left, right);
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
+ const bool left_ro_nonnum = !SvNIOKp(left) && SvREADONLY(left);
+ const bool right_ro_nonnum = !SvNIOKp(right) && SvREADONLY(right);
if (PL_op->op_private & HINT_INTEGER) {
const IV l = (USE_LEFT(left) ? SvIV_nomg(left) : 0);
const IV r = SvIV_nomg(right);
const UV result = op_type == OP_BIT_OR ? (l | r) : (l ^ r);
SETu(result);
}
+ if (left_ro_nonnum) SvNIOK_off(left);
+ if (right_ro_nonnum) SvNIOK_off(right);
}
else {
do_vop(op_type, TARG, left, right);
{
SV * const sv = TOPs;
const int flags = SvFLAGS(sv);
+
+ if( !SvNIOK( sv ) && looks_like_number( sv ) ){
+ SvIV_please( sv );
+ }
+
if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
/* It's publicly an integer, or privately an integer-not-float */
oops_its_an_int:
{
dVAR; dSP;
tryAMAGICun_MG(not_amg, AMGf_set);
- *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
+ *PL_stack_sp = boolSV(!SvTRUE_nomg(*PL_stack_sp));
return NORMAL;
}
PP(pp_srand)
{
- dVAR; dSP;
+ dVAR; dSP; dTARGET;
const UV anum = (MAXARG < 1) ? seed() : POPu;
(void)seedDrand01((Rand_seed_t)anum);
PL_srand_called = TRUE;
- EXTEND(SP, 1);
- RETPUSHYES;
+ if (anum)
+ XPUSHu(anum);
+ else {
+ /* Historically srand always returned true. We can avoid breaking
+ that like this: */
+ sv_setpvs(TARG, "0 but true");
+ XPUSHTARG;
+ }
+ RETURN;
}
PP(pp_int)
tmps++, len--;
if (*tmps == '0')
tmps++, len--;
- if (*tmps == 'x') {
+ if (*tmps == 'x' || *tmps == 'X') {
hex:
result_uv = grok_hex (tmps, &len, &flags, &result_nv);
}
- else if (*tmps == 'b')
+ else if (*tmps == 'b' || *tmps == 'B')
result_uv = grok_bin (tmps, &len, &flags, &result_nv);
else
result_uv = grok_oct (tmps, &len, &flags, &result_nv);
= sv_2pv_flags(sv, &len,
SV_UNDEF_RETURNS_NULL|SV_CONST_RETURN|SV_GMAGIC);
- if (!p)
- SETs(&PL_sv_undef);
+ if (!p) {
+ sv_setsv(TARG, &PL_sv_undef);
+ SETTARG;
+ }
else if (DO_UTF8(sv)) {
SETi(utf8_length((U8*)p, (U8*)p + len));
}
else
SETi(sv_len(sv));
} else {
- SETs(&PL_sv_undef);
+ sv_setsv_nomg(TARG, &PL_sv_undef);
+ SETTARG;
}
RETURN;
}
bool repl_need_utf8_upgrade = FALSE;
bool repl_is_utf8 = FALSE;
- SvTAINTED_off(TARG); /* decontaminate */
- SvUTF8_off(TARG); /* decontaminate */
if (num_args > 2) {
if (num_args > 3) {
repl_sv = POPs;
STRLEN byte_pos = utf8_curlen
? sv_pos_u2b_flags(sv, pos, &byte_len, SV_CONST_RETURN) : pos;
- tmps += byte_pos;
- /* we either return a PV or an LV. If the TARG hasn't been used
- * before, or is of that type, reuse it; otherwise use a mortal
- * instead. Note that LVs can have an extended lifetime, so also
- * dont reuse if refcount > 1 (bug #20933) */
- if (SvTYPE(TARG) > SVt_NULL) {
- if ( (SvTYPE(TARG) == SVt_PVLV)
- ? (!lvalue || SvREFCNT(TARG) > 1)
- : lvalue)
- {
- TARG = sv_newmortal();
+ if (lvalue && !repl) {
+ SV * ret;
+
+ if (!SvGMAGICAL(sv)) {
+ if (SvROK(sv)) {
+ SvPV_force_nolen(sv);
+ Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
+ "Attempt to use reference as lvalue in substr");
+ }
+ if (isGV_with_GP(sv))
+ SvPV_force_nolen(sv);
+ else if (SvOK(sv)) /* is it defined ? */
+ (void)SvPOK_only_UTF8(sv);
+ else
+ sv_setpvs(sv, ""); /* avoid lexical reincarnation */
}
+
+ ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */
+ sv_magic(ret, NULL, PERL_MAGIC_substr, NULL, 0);
+ LvTYPE(ret) = 'x';
+ LvTARG(ret) = SvREFCNT_inc_simple(sv);
+ LvTARGOFF(ret) = pos;
+ LvTARGLEN(ret) = len;
+
+ SPAGAIN;
+ PUSHs(ret); /* avoid SvSETMAGIC here */
+ RETURN;
}
+ SvTAINTED_off(TARG); /* decontaminate */
+ SvUTF8_off(TARG); /* decontaminate */
+
+ tmps += byte_pos;
sv_setpvn(TARG, tmps, byte_len);
#ifdef USE_LOCALE_COLLATE
sv_unmagic(TARG, PERL_MAGIC_collxfrm);
#endif
if (utf8_curlen)
SvUTF8_on(TARG);
+
if (repl) {
SV* repl_sv_copy = NULL;
SvUTF8_on(sv);
SvREFCNT_dec(repl_sv_copy);
}
- else if (lvalue) { /* it's an lvalue! */
- if (!SvGMAGICAL(sv)) {
- if (SvROK(sv)) {
- SvPV_force_nolen(sv);
- Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
- "Attempt to use reference as lvalue in substr");
- }
- if (isGV_with_GP(sv))
- SvPV_force_nolen(sv);
- else if (SvOK(sv)) /* is it defined ? */
- (void)SvPOK_only_UTF8(sv);
- else
- sv_setpvs(sv, ""); /* avoid lexical reincarnation */
- }
-
- if (SvTYPE(TARG) < SVt_PVLV) {
- sv_upgrade(TARG, SVt_PVLV);
- sv_magic(TARG, NULL, PERL_MAGIC_substr, NULL, 0);
- }
-
- LvTYPE(TARG) = 'x';
- if (LvTARG(TARG) != sv) {
- SvREFCNT_dec(LvTARG(TARG));
- LvTARG(TARG) = SvREFCNT_inc_simple(sv);
- }
- LvTARGOFF(TARG) = pos;
- LvTARGLEN(TARG) = len;
- }
}
SPAGAIN;
PUSHs(TARG); /* avoid SvSETMAGIC here */
PP(pp_vec)
{
- dVAR; dSP; dTARGET;
+ dVAR; dSP;
register const IV size = POPi;
register const IV offset = POPi;
register SV * const src = POPs;
const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
+ SV * ret;
- SvTAINTED_off(TARG); /* decontaminate */
if (lvalue) { /* it's an lvalue! */
- if (SvREFCNT(TARG) > 1) /* don't share the TARG (#20933) */
- TARG = sv_newmortal();
- if (SvTYPE(TARG) < SVt_PVLV) {
- sv_upgrade(TARG, SVt_PVLV);
- sv_magic(TARG, NULL, PERL_MAGIC_vec, NULL, 0);
- }
- LvTYPE(TARG) = 'v';
- if (LvTARG(TARG) != src) {
- SvREFCNT_dec(LvTARG(TARG));
- LvTARG(TARG) = SvREFCNT_inc_simple(src);
- }
- LvTARGOFF(TARG) = offset;
- LvTARGLEN(TARG) = size;
+ ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */
+ sv_magic(ret, NULL, PERL_MAGIC_vec, NULL, 0);
+ LvTYPE(ret) = 'v';
+ LvTARG(ret) = SvREFCNT_inc_simple(src);
+ LvTARGOFF(ret) = offset;
+ LvTARGLEN(ret) = size;
+ }
+ else {
+ dTARGET;
+ SvTAINTED_off(TARG); /* decontaminate */
+ ret = TARG;
}
- sv_setuv(TARG, do_vecget(src, offset, size));
- PUSHs(TARG);
+ sv_setuv(ret, do_vecget(src, offset, size));
+ PUSHs(ret);
RETURN;
}
#else
DIE(aTHX_
"The crypt() function is unimplemented due to excessive paranoia.");
- return NORMAL;
#endif
}
const U8 *const send = s + len;
U8 tmpbuf[UTF8_MAXBYTES+1];
-/* This is ifdefd out because it needs more work and thought. It isn't clear
- * that we should do it. These are hard-coded rules from the Unicode standard,
- * and may change. 5.2 gives new guidance on the iota subscript, for example,
- * which has not been checked against this; and secondly it may be that we are
- * passed a subset of the context, via a \U...\E, for example, and its not
- * clear what the best approach is to that */
-#ifdef CONTEXT_DEPENDENT_CASING
+ /* All occurrences of these are to be moved to follow any other marks.
+ * This is context-dependent. We may not be passed enough context to
+ * move the iota subscript beyond all of them, but we do the best we can
+ * with what we're given. The result is always better than if we
+ * hadn't done this. And, the problem would only arise if we are
+ * passed a character without all its combining marks, which would be
+ * the caller's mistake. The information this is based on comes from a
+ * comment in Unicode SpecialCasing.txt, (and the Standard's text
+ * itself) and so can't be checked properly to see if it ever gets
+ * revised. But the likelihood of it changing is remote */
bool in_iota_subscript = FALSE;
-#endif
while (s < send) {
-#ifdef CONTEXT_DEPENDENT_CASING
if (in_iota_subscript && ! is_utf8_mark(s)) {
/* A non-mark. Time to output the iota subscript */
#define GREEK_CAPITAL_LETTER_IOTA 0x0399
CAT_UNI_TO_UTF8_TWO_BYTE(d, GREEK_CAPITAL_LETTER_IOTA);
in_iota_subscript = FALSE;
}
-#endif
/* See comments at the first instance in this file of this ifdef */
const STRLEN u = UTF8SKIP(s);
STRLEN ulen;
-#ifndef CONTEXT_DEPENDENT_CASING
- toUPPER_utf8(s, tmpbuf, &ulen);
-#else
const UV uv = toUPPER_utf8(s, tmpbuf, &ulen);
- if (uv == GREEK_CAPITAL_LETTER_IOTA && utf8_to_uvchr(s, 0) == COMBINING_GREEK_YPOGEGRAMMENI) {
+ if (uv == GREEK_CAPITAL_LETTER_IOTA
+ && utf8_to_uvchr(s, 0) == COMBINING_GREEK_YPOGEGRAMMENI)
+ {
in_iota_subscript = TRUE;
}
else {
-#endif
if (ulen > u && (SvLEN(dest) < (min += ulen - u))) {
/* If the eventually required minimum size outgrows
* the available space, we need to grow. */
/* If someone uppercases one million U+03B0s we
* SvGROW() one million times. Or we could try
* guessing how much to allocate without allocating too
- * much. Such is life. See corresponding comment in lc code
- * for another option */
+ * much. Such is life. See corresponding comment in
+ * lc code for another option */
SvGROW(dest, min);
d = (U8*)SvPVX(dest) + o;
}
Copy(tmpbuf, d, ulen, U8);
d += ulen;
-#ifdef CONTEXT_DEPENDENT_CASING
}
-#endif
s += u;
}
}
-#ifdef CONTEXT_DEPENDENT_CASING
- if (in_iota_subscript) CAT_UNI_TO_UTF8_TWO_BYTE(d, GREEK_CAPITAL_LETTER_IOTA);
-#endif
+ if (in_iota_subscript) {
+ CAT_UNI_TO_UTF8_TWO_BYTE(d, GREEK_CAPITAL_LETTER_IOTA);
+ }
SvUTF8_on(dest);
*d = '\0';
SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
- } else { /* Not UTF-8 */
+ }
+ else { /* Not UTF-8 */
if (len) {
const U8 *const send = s + len;
const STRLEN u = UTF8SKIP(s);
STRLEN ulen;
-/* See comments at the first instance in this file of this ifdef */
#ifndef CONTEXT_DEPENDENT_CASING
toLOWER_utf8(s, tmpbuf, &ulen);
#else
- /* Here is context dependent casing, not compiled in currently;
- * needs more thought and work */
+/* This is ifdefd out because it needs more work and thought. It isn't clear
+ * that we should do it.
+ * A minor objection is that this is based on a hard-coded rule from the
+ * Unicode standard, and may change, but this is not very likely at all.
+ * mktables should check and warn if it does.
+ * More importantly, if the sigma occurs at the end of the string, we don't
+ * have enough context to know whether it is part of a larger string or going
+ * to be or not. It may be that we are passed a subset of the context, via
+ * a \U...\E, for example, and we could conceivably know the larger context if
+ * code were changed to pass that in. But, if the string passed in is an
+ * intermediate result, and the user concatenates two strings together
+ * after we have made a final sigma, that would be wrong. If the final sigma
+ * occurs in the middle of the string we are working on, then we know that it
+ * should be a final sigma, but otherwise we can't be sure. */
const UV uv = toLOWER_utf8(s, tmpbuf, &ulen);
RETURN;
}
+/* Smart dereferencing for keys, values and each */
+PP(pp_rkeys)
+{
+ dVAR;
+ dSP;
+ dPOPss;
+
+ if (!SvOK(sv))
+ RETURN;
+
+ if (SvROK(sv)) {
+ SvGETMAGIC(sv);
+ if (SvAMAGIC(sv)) {
+ /* N.B.: AMG macros return sv if no overloading is found */
+ SV *maybe_hv = AMG_CALLun(sv,to_hv);
+ SV *maybe_av = AMG_CALLun(sv,to_av);
+ if ( maybe_hv != sv && maybe_av != sv ) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "%s",
+ Perl_form(aTHX_ "Ambiguous overloaded argument to %s resolved as %%{}",
+ PL_op_desc[PL_op->op_type]
+ )
+ );
+ sv = maybe_hv;
+ }
+ else if ( maybe_av != sv ) {
+ if ( SvTYPE(SvRV(sv)) == SVt_PVHV ) {
+ /* @{} overload, but underlying reftype is HV */
+ Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "%s",
+ Perl_form(aTHX_ "Ambiguous overloaded argument to %s resolved as @{}",
+ PL_op_desc[PL_op->op_type]
+ )
+ );
+ }
+ sv = maybe_av;
+ }
+ else if ( maybe_hv != sv ) {
+ if ( SvTYPE(SvRV(sv)) == SVt_PVAV ) {
+ /* %{} overload, but underlying reftype is AV */
+ Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "%s",
+ Perl_form(aTHX_ "Ambiguous overloaded argument to %s resolved as %%{}",
+ PL_op_desc[PL_op->op_type]
+ )
+ );
+ }
+ sv = maybe_hv;
+ }
+ }
+ sv = SvRV(sv);
+ }
+
+ if ( SvTYPE(sv) != SVt_PVHV && SvTYPE(sv) != SVt_PVAV ) {
+ DIE(aTHX_ Perl_form(aTHX_ "Type of argument to %s must be hashref or arrayref",
+ PL_op_desc[PL_op->op_type] ));
+ }
+
+ /* Delegate to correct function for op type */
+ PUSHs(sv);
+ if (PL_op->op_type == OP_RKEYS || PL_op->op_type == OP_RVALUES) {
+ return (SvTYPE(sv) == SVt_PVHV) ? Perl_do_kv(aTHX) : Perl_pp_akeys(aTHX);
+ }
+ else {
+ return (SvTYPE(sv) == SVt_PVHV) ? Perl_pp_each(aTHX) : Perl_pp_aeach(aTHX);
+ }
+}
+
PP(pp_aeach)
{
dVAR;
EXTEND(SP, n + 1);
- if (PL_op->op_type == OP_AKEYS) {
+ if (PL_op->op_type == OP_AKEYS || PL_op->op_type == OP_RKEYS) {
n += i;
for (; i <= n; i++) {
mPUSHi(i);
*MARK = &PL_sv_undef;
Safefree(tmparyval);
}
+
+ if (SvMAGICAL(ary))
+ mg_set(MUTABLE_SV(ary));
+
SP = MARK;
RETURN;
}
sv_setsv(sv, *MARK);
av_store(ary, AvFILLp(ary)+1, sv);
}
- if (PL_delaymagic & DM_ARRAY)
+ if (PL_delaymagic & DM_ARRAY_ISA)
mg_set(MUTABLE_SV(ary));
PL_delaymagic = 0;
register I32 tmp;
dTARGET;
STRLEN len;
- PADOFFSET padoff_du;
SvUTF8_off(TARG); /* decontaminate */
if (SP - MARK > 1)
do_join(TARG, &PL_sv_no, MARK, SP);
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)));
-
+ sv_setsv(TARG, SP > MARK ? *SP : find_rundefsv());
if (! SvOK(TARG) && ckWARN(WARN_UNINITIALIZED))
report_uninit(TARG);
}
dVAR;
DIE(aTHX_ "panic: unimplemented op %s (#%d) called", OP_NAME(PL_op),
PL_op->op_type);
- return NORMAL;
}
PP(pp_boolkeys)