sv_usepvn(temp, pv, llen);
little_p = SvPVX(little);
} else {
- temp = little_utf8
- ? newSVpvn(big_p, biglen) : newSVpvn(little_p, llen);
+ temp = newSVpvn(little_p, llen);
sv_utf8_upgrade(temp);
- if (little_utf8) {
- big = temp;
- big_utf8 = TRUE;
- big_p = SvPV_const(big, biglen);
- } else {
- little = temp;
- little_p = SvPV_const(little, llen);
- }
+ little = temp;
+ little_p = SvPV_const(little, llen);
}
}
if (SvGAMAGIC(big)) {
* allocate without allocating too much. Such is life.
* See corresponding comment in lc code for another option
* */
- SvGROW(dest, min);
- d = (U8*)SvPVX(dest) + o;
+ d = o + (U8*) SvGROW(dest, min);
}
Copy(tmpbuf, d, ulen, U8);
d += ulen;
* ASCII. If not enough room, grow the string */
if (SvLEN(dest) < ++min) {
const UV o = d - (U8*)SvPVX_const(dest);
- SvGROW(dest, min);
- d = (U8*)SvPVX(dest) + o;
+ d = o + (U8*) SvGROW(dest, min);
}
*d++ = 'S'; *d = 'S'; /* upper case is 'SS' */
continue; /* Back to the tight loop; still in ASCII */
* Another option would be to grow an extra byte or two more
* each time we need to grow, which would cut down the million
* to 500K, with little waste */
- SvGROW(dest, min);
- d = (U8*)SvPVX(dest) + o;
+ d = o + (U8*) SvGROW(dest, min);
}
/* Copy the newly lowercased letter to the output buffer we're
if (ulen > u && (SvLEN(dest) < (min += ulen - u))) {
const UV o = d - (U8*)SvPVX_const(dest);
- SvGROW(dest, min);
- d = (U8*)SvPVX(dest) + o;
+ d = o + (U8*) SvGROW(dest, min);
}
Copy(tmpbuf, d, ulen, U8);
* becomes "ss", which may require growing the SV. */
if (SvLEN(dest) < ++min) {
const UV o = d - (U8*)SvPVX_const(dest);
- SvGROW(dest, min);
- d = (U8*)SvPVX(dest) + o;
+ d = o + (U8*) SvGROW(dest, min);
}
*(d)++ = 's';
*d = 's';
for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
SvREFCNT_dec(*dst++); /* free them now */
}
+ if (!*MARK)
+ *MARK = &PL_sv_undef;
}
AvFILLp(ary) += diff;
while (length-- > 0)
SvREFCNT_dec(tmparyval[length]);
}
+ if (!*MARK)
+ *MARK = &PL_sv_undef;
}
else
*MARK = &PL_sv_undef;
* or
* my @foo = @_[N..$#_]
* etc
- *
- * It assumes that the pad var is currently uninitialised, so this op
- * should only be used at the start of a sub, where its not possible to
- * skip the op (e.g. no 'my $x if $cond' stuff for example).
*/
PP(pp_argelem)
SV ** padentry;
OP *o = PL_op;
AV *defav = GvAV(PL_defgv); /* @_ */
- UV ix = PTR2UV(cUNOP_AUXo->op_aux);
+ IV ix = PTR2IV(cUNOP_AUXo->op_aux);
IV argc;
- SV **argv;
-
- assert(!SvMAGICAL(defav));
/* do 'my $var, @var or %var' action */
padentry = &(PAD_SVl(o->op_targ));
PUTBACK;
}
else {
+ SV **svp;
/* should already have been checked */
- assert(ix < I32_MAX && AvFILLp(defav) >= (I32)ix);
- val = AvARRAY(defav)[ix];
- if (UNLIKELY(!val))
- val = &PL_sv_undef;
+ assert(ix >= 0);
+#if IVSIZE > PTRSIZE
+ assert(ix <= SSize_t_MAX);
+#endif
+
+ svp = av_fetch(defav, ix, FALSE);
+ val = svp ? *svp : &PL_sv_undef;
}
/* $var = $val */
if (UNLIKELY(TAINT_get) && !SvTAINTED(val))
TAINT_NOT;
- /* Short-cut assignment of IV and RV values as these are
- * common and simple. For RVs, it's likely that on
- * subsequent calls to a function, targ is already of the
- * correct storage class */
- if (LIKELY(!SvMAGICAL(val))) {
- /* just an IV */
- if ((SvFLAGS(val) & (SVf_IOK|SVf_NOK|SVf_POK|SVf_IVisUV)) == SVf_IOK) {
- IV i = SvIVX(val);
- if (LIKELY(SvTYPE(targ) == SVt_IV)) {
- assert(!SvOK(targ));
- assert(!SvMAGICAL(targ));
- (void)SvIOK_only(targ);
- SvIV_set(targ, i);
- }
- else
- sv_setiv(targ, i);
- }
- else if (SvROK(val) && SvTYPE(targ) == SVt_IV) {
- /* quick ref assignment */
- assert(!SvOK(targ));
- SvRV_set(targ, SvREFCNT_inc(SvRV(val)));
- SvROK_on(targ);
- }
- else
- sv_setsv(targ, val);
- }
- else
- sv_setsv(targ, val);
+ SvSetMagicSV(targ, val);
return o->op_next;
}
/* must be AV or HV */
assert(!(o->op_flags & OPf_STACKED));
- argc = ((IV)AvFILLp(defav) + 1) - (IV)ix;
- assert(!SvMAGICAL(targ));
- if (argc <= 0)
- return o->op_next;
- argv = AvARRAY(defav) + ix;
- assert(argv);
+ argc = ((IV)AvFILL(defav) + 1) - ix;
/* This is a copy of the relevant parts of pp_aassign().
- * We *know* that @foo / %foo is a plain empty lexical at this point,
- * so we can avoid a lot of the extra baggage.
- * We know, because all the usual tricks like 'my @a if 0',
- * 'foo: my @a = ...; goto foo' can't be done with signatures.
*/
if ((o->op_private & OPpARGELEM_MASK) == OPpARGELEM_AV) {
- UV i = 0;
+ IV i;
+
+ if (AvFILL((AV*)targ) > -1) {
+ /* target should usually be empty. If we get get
+ * here, someone's been doing some weird closure tricks.
+ * Make a copy of all args before clearing the array,
+ * to avoid the equivalent of @a = ($a[0]) prematurely freeing
+ * elements. See similar code in pp_aassign.
+ */
+ for (i = 0; i < argc; i++) {
+ SV **svp = av_fetch(defav, ix + i, FALSE);
+ SV *newsv = newSV(0);
+ sv_setsv_flags(newsv,
+ svp ? *svp : &PL_sv_undef,
+ (SV_DO_COW_SVSETSV|SV_NOSTEAL));
+ if (!av_store(defav, ix + i, newsv))
+ SvREFCNT_dec_NN(newsv);
+ }
+ av_clear((AV*)targ);
+ }
+
+ if (argc <= 0)
+ return o->op_next;
- assert(AvFILLp((AV*)targ) == -1); /* can skip av_clear() */
av_extend((AV*)targ, argc);
+ i = 0;
while (argc--) {
SV *tmpsv;
- SV *arg = *argv++;
+ SV **svp = av_fetch(defav, ix + i, FALSE);
+ SV *val = svp ? *svp : &PL_sv_undef;
tmpsv = newSV(0);
- sv_setsv(tmpsv, arg);
+ sv_setsv(tmpsv, val);
av_store((AV*)targ, i++, tmpsv);
TAINT_NOT;
}
}
else {
+ IV i;
+
assert((o->op_private & OPpARGELEM_MASK) == OPpARGELEM_HV);
+ if (SvRMAGICAL(targ) || HvUSEDKEYS((HV*)targ)) {
+ /* see "target should usually be empty" comment above */
+ for (i = 0; i < argc; i++) {
+ SV **svp = av_fetch(defav, ix + i, FALSE);
+ SV *newsv = newSV(0);
+ sv_setsv_flags(newsv,
+ svp ? *svp : &PL_sv_undef,
+ (SV_DO_COW_SVSETSV|SV_NOSTEAL));
+ if (!av_store(defav, ix + i, newsv))
+ SvREFCNT_dec_NN(newsv);
+ }
+ hv_clear((HV*)targ);
+ }
+
+ if (argc <= 0)
+ return o->op_next;
assert(argc % 2 == 0);
- assert(!HvTOTALKEYS(targ)); /* can skip hv_clear() */
+ i = 0;
while (argc) {
SV *tmpsv;
- SV *key = *argv++;
- SV *val = *argv++;
+ SV **svp;
+ SV *key;
+ SV *val;
+
+ svp = av_fetch(defav, ix + i++, FALSE);
+ key = svp ? *svp : &PL_sv_undef;
+ svp = av_fetch(defav, ix + i++, FALSE);
+ val = svp ? *svp : &PL_sv_undef;
- assert(key); assert(val);
argc -= 2;
if (UNLIKELY(SvGMAGICAL(key)))
key = sv_mortalcopy(key);
{
OP * const o = PL_op;
AV *defav = GvAV(PL_defgv); /* @_ */
- PADOFFSET ix = o->op_targ;
+ IV ix = (IV)o->op_targ;
- assert(!SvMAGICAL(defav));
- assert(ix < I32_MAX);
- if (AvFILLp(defav) >= (I32)ix) {
+ assert(ix >= 0);
+#if IVSIZE > PTRSIZE
+ assert(ix <= SSize_t_MAX);
+#endif
+
+ if (AvFILL(defav) >= ix) {
dSP;
- XPUSHs(AvARRAY(defav)[ix]);
+ SV **svp = av_fetch(defav, ix, FALSE);
+ SV *val = svp ? *svp : &PL_sv_undef;
+ XPUSHs(val);
RETURN;
}
return cLOGOPo->op_other;
{
OP * const o = PL_op;
UNOP_AUX_item *aux = cUNOP_AUXo->op_aux;
- UV params = aux[0].uv;
- UV opt_params = aux[1].uv;
+ IV params = aux[0].iv;
+ IV opt_params = aux[1].iv;
char slurpy = (char)(aux[2].iv);
AV *defav = GvAV(PL_defgv); /* @_ */
- UV argc;
+ IV argc;
bool too_few;
assert(!SvMAGICAL(defav));
- argc = (UV)(AvFILLp(defav) + 1);
+ argc = (AvFILLp(defav) + 1);
too_few = (argc < (params - opt_params));
if (UNLIKELY(too_few || (!slurpy && argc > params)))
https://perl5.git.perl.org / perl5.git / blobdiff