PL_stack_max = PL_stack_base + newmax;
}
} else { /* there is no SV* array yet */
- *maxp = key < 3 ? 3 : key;
+ *maxp = key < PERL_ARRAY_NEW_MIN_KEY ?
+ PERL_ARRAY_NEW_MIN_KEY : key;
{
/* see comment above about newmax+1*/
MEM_WRAP_CHECK_s(*maxp, SV*,
=for apidoc av_fetch
Returns the SV at the specified index in the array. The C<key> is the
-index. If lval is true, you are guaranteed to get a real SV back (in case
+index. If C<lval> is true, you are guaranteed to get a real SV back (in case
it wasn't real before), which you can then modify. Check that the return
-value is non-null before dereferencing it to a C<SV*>.
+value is non-NULL before dereferencing it to a C<SV*>.
See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
more information on how to use this function on tied arrays.
if ((Size_t)key >= (Size_t)size) {
if (UNLIKELY(neg))
return NULL;
- goto emptyness;
+ goto emptiness;
}
if (!AvARRAY(av)[key]) {
- emptyness:
+ emptiness:
return lval ? av_store(av,key,newSV_type(SVt_NULL)) : NULL;
}
}
else if (AvREAL(av))
SvREFCNT_dec(ary[key]);
+
+ /* store the val into the AV before we call magic so that the magic can
+ * "see" the new value. Especially set magic on the AV itself. */
ary[key] = val;
+
if (SvSMAGICAL(av)) {
const MAGIC *mg = SvMAGIC(av);
bool set = TRUE;
+ /* We have to increment the refcount on val before we call any magic,
+ * as it is now stored in the AV (just before this block), we will
+ * then call the magic handlers which might die/Perl_croak, and
+ * longjmp up the stack to the most recent exception trap. Which means
+ * the caller code that would be expected to handle the refcount
+ * increment likely would never be executed, leading to a double free.
+ * This can happen in a case like
+ *
+ * @ary = (1);
+ *
+ * or this:
+ *
+ * if (av_store(av,n,sv)) SvREFCNT_inc(sv);
+ *
+ * where @ary/av has set magic applied to it which can die. In the
+ * first case the sv representing 1 would be mortalized, so when the
+ * set magic threw an exception it would be freed as part of the
+ * normal stack unwind. However this leaves the av structure still
+ * holding a valid visible pointer to the now freed value. In practice
+ * the next SV created will reuse the same reference, but without the
+ * refcount to account for the previous ownership and we end up with
+ * warnings about a totally different variable being double freed in
+ * the form of "attempt to free unreferenced variable"
+ * warnings/errors.
+ *
+ * https://github.com/Perl/perl5/issues/20675
+ *
+ * Arguably the API for av_store is broken in the face of magic. Instead
+ * av_store should be responsible for the refcount increment, and only
+ * not do it when specifically told to do so (eg, when storing an
+ * otherwise unreferenced scalar into an AV).
+ */
+ SvREFCNT_inc(val); /* see comment above */
for (; mg; mg = mg->mg_moremagic) {
if (!isUPPER(mg->mg_type)) continue;
if (val) {
}
if (set)
mg_set(MUTABLE_SV(av));
+ /* And now we are done the magic, we have to decrement it back as the av_store() api
+ * says the caller is responsible for the refcount increment, assuming
+ * av_store returns true. */
+ SvREFCNT_dec(val);
}
return &ary[key];
}
/*
-=for apidoc av_new_alloc
-
-Creates a new AV and allocates its SV* array.
-
-This is similar to but more efficient than doing:
-
- AV *av = newAV();
- av_extend(av, key);
-
-The size parameter is used to pre-allocate a SV* array large enough to
-hold at least elements 0..(size-1). size must be at least 1.
-
-The zeroflag parameter controls whether the array is NULL initialized.
-
-=cut
-*/
-
-AV *
-Perl_av_new_alloc(pTHX_ SSize_t size, bool zeroflag)
-{
- AV * const av = newAV();
- SV** ary;
- PERL_ARGS_ASSERT_AV_NEW_ALLOC;
- assert(size > 0);
-
- Newx(ary, size, SV*); /* Newx performs the memwrap check */
- AvALLOC(av) = ary;
- AvARRAY(av) = ary;
- AvMAX(av) = size - 1;
-
- if (zeroflag)
- Zero(ary, size, SV*);
-
- return av;
-}
-
-/*
=for apidoc av_make
-Creates a new AV and populates it with a list of SVs. The SVs are copied
-into the array, so they may be freed after the call to C<av_make>. The new AV
-will have a reference count of 1.
+Creates a new AV and populates it with a list (C<**strp>, length C<size>) of
+SVs. A copy is made of each SV, so their refcounts are not changed. The new
+AV will have a reference count of 1.
Perl equivalent: C<my @new_array = ($scalar1, $scalar2, $scalar3...);>
}
/*
+=for apidoc newAVav
+
+Creates a new AV and populates it with values copied from an existing AV. The
+new AV will have a reference count of 1, and will contain newly created SVs
+copied from the original SV. The original source will remain unchanged.
+
+Perl equivalent: C<my @new_array = @existing_array;>
+
+=cut
+*/
+
+AV *
+Perl_newAVav(pTHX_ AV *oav)
+{
+ PERL_ARGS_ASSERT_NEWAVAV;
+
+ Size_t count = av_count(oav);
+
+ if(UNLIKELY(!oav) || count == 0)
+ return newAV();
+
+ AV *ret = newAV_alloc_x(count);
+
+ /* avoid ret being leaked if croak when calling magic below */
+ EXTEND_MORTAL(1);
+ PL_tmps_stack[++PL_tmps_ix] = (SV *)ret;
+ SSize_t ret_at_tmps_ix = PL_tmps_ix;
+
+ Size_t i;
+ if(LIKELY(!SvRMAGICAL(oav) && AvREAL(oav) && (SvTYPE(oav) == SVt_PVAV))) {
+ for(i = 0; i < count; i++) {
+ SV **svp = av_fetch_simple(oav, i, 0);
+ av_push_simple(ret, svp ? newSVsv(*svp) : &PL_sv_undef);
+ }
+ } else {
+ for(i = 0; i < count; i++) {
+ SV **svp = av_fetch(oav, i, 0);
+ av_push_simple(ret, svp ? newSVsv(*svp) : &PL_sv_undef);
+ }
+ }
+
+ /* disarm leak guard */
+ if(LIKELY(PL_tmps_ix == ret_at_tmps_ix))
+ PL_tmps_ix--;
+ else
+ PL_tmps_stack[ret_at_tmps_ix] = &PL_sv_undef;
+
+ return ret;
+}
+
+/*
+=for apidoc newAVhv
+
+Creates a new AV and populates it with keys and values copied from an existing
+HV. The new AV will have a reference count of 1, and will contain newly
+created SVs copied from the original HV. The original source will remain
+unchanged.
+
+Perl equivalent: C<my @new_array = %existing_hash;>
+
+=cut
+*/
+
+AV *
+Perl_newAVhv(pTHX_ HV *ohv)
+{
+ PERL_ARGS_ASSERT_NEWAVHV;
+
+ if(UNLIKELY(!ohv))
+ return newAV();
+
+ bool tied = SvRMAGICAL(ohv) && mg_find(MUTABLE_SV(ohv), PERL_MAGIC_tied);
+
+ Size_t nkeys = hv_iterinit(ohv);
+ /* This number isn't perfect but it doesn't matter; it only has to be
+ * close to make the initial allocation about the right size
+ */
+ AV *ret = newAV_alloc_xz(nkeys ? nkeys * 2 : 2);
+
+ /* avoid ret being leaked if croak when calling magic below */
+ EXTEND_MORTAL(1);
+ PL_tmps_stack[++PL_tmps_ix] = (SV *)ret;
+ SSize_t ret_at_tmps_ix = PL_tmps_ix;
+
+
+ HE *he;
+ while((he = hv_iternext(ohv))) {
+ if(tied) {
+ av_push_simple(ret, newSVsv(hv_iterkeysv(he)));
+ av_push_simple(ret, newSVsv(hv_iterval(ohv, he)));
+ }
+ else {
+ av_push_simple(ret, newSVhek(HeKEY_hek(he)));
+ av_push_simple(ret, HeVAL(he) ? newSVsv(HeVAL(he)) : &PL_sv_undef);
+ }
+ }
+
+ /* disarm leak guard */
+ if(LIKELY(PL_tmps_ix == ret_at_tmps_ix))
+ PL_tmps_ix--;
+ else
+ PL_tmps_stack[ret_at_tmps_ix] = &PL_sv_undef;
+
+ return ret;
+}
+
+/*
=for apidoc av_clear
Frees all the elements of an array, leaving it empty.
Perl_av_undef(pTHX_ AV *av)
{
bool real;
- SSize_t orig_ix = PL_tmps_ix; /* silence bogus warning about possible unitialized use */
+ SSize_t orig_ix = PL_tmps_ix; /* silence bogus warning about possible uninitialized use */
PERL_ARGS_ASSERT_AV_UNDEF;
assert(SvTYPE(av) == SVt_PVAV);
https://perl5.git.perl.org / perl5.git / blobdiff