if (he)
targ = HeVAL(he);
}
- else {
+ else if (LvSTARGOFF(sv) >= 0) {
AV *const av = MUTABLE_AV(LvTARG(sv));
- if ((I32)LvTARGOFF(sv) <= AvFILL(av))
- targ = AvARRAY(av)[LvTARGOFF(sv)];
+ if (LvSTARGOFF(sv) <= AvFILL(av))
+ targ = AvARRAY(av)[LvSTARGOFF(sv)];
}
if (targ && (targ != &PL_sv_undef)) {
/* somebody else defined it for us */
if (!value || value == &PL_sv_undef)
Perl_croak(aTHX_ PL_no_helem_sv, SVfARG(mg->mg_obj));
}
+ else if (LvSTARGOFF(sv) < 0)
+ Perl_croak(aTHX_ PL_no_aelem, LvSTARGOFF(sv));
else {
AV *const av = MUTABLE_AV(LvTARG(sv));
- if ((I32)LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av))
+ if ((I32)LvTARGLEN(sv) < 0 && LvSTARGOFF(sv) > AvFILL(av))
LvTARG(sv) = NULL; /* array can't be extended */
else {
- SV* const * const svp = av_fetch(av, LvTARGOFF(sv), TRUE);
+ SV* const * const svp = av_fetch(av, LvSTARGOFF(sv), TRUE);
if (!svp || (value = *svp) == &PL_sv_undef)
- Perl_croak(aTHX_ PL_no_aelem, (I32)LvTARGOFF(sv));
+ Perl_croak(aTHX_ PL_no_aelem, LvSTARGOFF(sv));
}
}
SvREFCNT_inc_simple_void(value);
IV elem = SvIV(elemsv);
AV *const av = MUTABLE_AV(POPs);
const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
- const U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > av_len(av));
+ const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
bool preeminent = TRUE;
SV *sv;
#endif
if (!svp || !*svp) {
SV* lv;
+ IV len;
if (!defer)
DIE(aTHX_ PL_no_aelem, elem);
+ len = av_len(av);
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
LvTYPE(lv) = 'y';
sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
LvTARG(lv) = SvREFCNT_inc_simple(av);
- LvTARGOFF(lv) = elem;
+ /* Resolve a negative index now, unless it points before the
+ beginning of the array, in which case record it for error
+ reporting in magic_setdefelem. */
+ LvSTARGOFF(lv) =
+ elem < 0 && len + elem >= 0 ? len + elem : elem;
LvTARGLEN(lv) = 1;
PUSHs(lv);
RETURN;
_XPV_HEAD;
union _xivu xiv_u;
union _xnvu xnv_u;
- STRLEN xlv_targoff;
+ union {
+ STRLEN xlvu_targoff;
+ SSize_t xlvu_stargoff;
+ } xlv_targoff_u;
STRLEN xlv_targlen;
SV* xlv_targ;
char xlv_type; /* k=keys .=pos x=substr v=vec /=join/re
char xlv_flags; /* 1 = negative offset 2 = negative len */
};
+#define xlv_targoff xlv_targoff_u.xlvu_targoff
+
struct xpvinvlist {
_XPV_HEAD;
IV prev_index;
#define LvTYPE(sv) ((XPVLV*) SvANY(sv))->xlv_type
#define LvTARG(sv) ((XPVLV*) SvANY(sv))->xlv_targ
#define LvTARGOFF(sv) ((XPVLV*) SvANY(sv))->xlv_targoff
+#define LvSTARGOFF(sv) ((XPVLV*) SvANY(sv))->xlv_targoff_u.xlvu_stargoff
#define LvTARGLEN(sv) ((XPVLV*) SvANY(sv))->xlv_targlen
#define LvFLAGS(sv) ((XPVLV*) SvANY(sv))->xlv_flags
require 'test.pl';
}
-plan (129);
+plan (135);
#
# @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them
is \$_[0], \undef, 'undef preserves identity in array [perl #109726]';
}->(undef);
+# [perl #118691]
+@plink=@plunk=();
+$plink[3] = 1;
+sub {
+ $_[0] = 2;
+ is $plink[0], 2, '@_ alias to nonexistent elem within array';
+ $_[1] = 3;
+ is $plink[1], 3, '@_ alias to nonexistent neg index within array';
+ is $_[2], undef, 'reading alias to negative index past beginning';
+ eval { $_[2] = 42 };
+ like $@, qr/Modification of non-creatable array value attempted, (?x:
+ )subscript -5/,
+ 'error when setting alias to negative index past beginning';
+ is $_[3], undef, 'reading alias to -1 elem of empty array';
+ eval { $_[3] = 42 };
+ like $@, qr/Modification of non-creatable array value attempted, (?x:
+ )subscript -1/,
+ 'error when setting alias to -1 elem of empty array';
+}->($plink[0], $plink[-2], $plink[-5], $plunk[-1]);
+
"We're included by lib/Tie/Array/std.t so we need to return something true";