void
Perl_av_reify(pTHX_ AV *av)
{
- dVAR;
SSize_t key;
PERL_ARGS_ASSERT_AV_REIFY;
void
Perl_av_extend(pTHX_ AV *av, SSize_t key)
{
- dVAR;
MAGIC *mg;
PERL_ARGS_ASSERT_AV_EXTEND;
Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp,
SV ***arrayp)
{
- dVAR;
-
PERL_ARGS_ASSERT_AV_EXTEND_GUTS;
if (key > *maxp) {
}
}
else {
-#ifdef PERL_MALLOC_WRAP
- static const char oom_array_extend[] =
- "Out of memory during array extend"; /* Duplicated in pp_hot.c */
-#endif
-
if (*allocp) {
#ifdef Perl_safesysmalloc_size
if (key <= newmax)
goto resized;
#endif
- newmax = key + *maxp / 5;
+ /* overflow-safe version of newmax = key + *maxp/5 */
+ newmax = *maxp / 5;
+ newmax = (key > SSize_t_MAX - newmax)
+ ? SSize_t_MAX : key + newmax;
resize:
- MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
+ {
+#ifdef PERL_MALLOC_WRAP /* Duplicated in pp_hot.c */
+ static const char oom_array_extend[] =
+ "Out of memory during array extend";
+#endif
+ /* it should really be newmax+1 here, but if newmax
+ * happens to equal SSize_t_MAX, then newmax+1 is
+ * undefined. This means technically we croak one
+ * index lower than we should in theory; in practice
+ * its unlikely the system has SSize_t_MAX/sizeof(SV*)
+ * bytes to spare! */
+ MEM_WRAP_CHECK_1(newmax, SV*, oom_array_extend);
+ }
+#ifdef STRESS_REALLOC
+ {
+ SV ** const old_alloc = *allocp;
+ Newx(*allocp, newmax+1, SV*);
+ Copy(old_alloc, *allocp, *maxp + 1, SV*);
+ Safefree(old_alloc);
+ }
+#else
Renew(*allocp,newmax+1, SV*);
+#endif
#ifdef Perl_safesysmalloc_size
resized:
#endif
}
else {
newmax = key < 3 ? 3 : key;
- MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
+ {
+#ifdef PERL_MALLOC_WRAP /* Duplicated in pp_hot.c */
+ static const char oom_array_extend[] =
+ "Out of memory during array extend";
+#endif
+ /* see comment above about newmax+1*/
+ MEM_WRAP_CHECK_1(newmax, SV*, oom_array_extend);
+ }
Newx(*allocp, newmax+1, SV*);
ary = *allocp + 1;
tmp = newmax;
SV**
Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval)
{
- dVAR;
-
PERL_ARGS_ASSERT_AV_FETCH;
assert(SvTYPE(av) == SVt_PVAV);
Stores an SV in an array. The array index is specified as C<key>. The
return value will be NULL if the operation failed or if the value did not
need to be actually stored within the array (as in the case of tied
-arrays). Otherwise, it can be dereferenced
+arrays). Otherwise, it can be dereferenced
to get the C<SV*> that was stored
there (= C<val>)).
SV**
Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val)
{
- dVAR;
SV** ary;
PERL_ARGS_ASSERT_AV_STORE;
void
Perl_av_clear(pTHX_ AV *av)
{
- dVAR;
SSize_t extra;
bool real;
void
Perl_av_push(pTHX_ AV *av, SV *val)
{
- dVAR;
MAGIC *mg;
PERL_ARGS_ASSERT_AV_PUSH;
SV *
Perl_av_pop(pTHX_ AV *av)
{
- dVAR;
SV *retval;
MAGIC* mg;
void
Perl_av_unshift(pTHX_ AV *av, SSize_t num)
{
- dVAR;
SSize_t i;
MAGIC* mg;
SV *
Perl_av_shift(pTHX_ AV *av)
{
- dVAR;
SV *retval;
MAGIC* mg;
=for apidoc av_len
-Same as L</av_top_index>. Returns the highest index in the array. Note that the
-return value is +1 what its name implies it returns; and hence differs in
-meaning from what the similarly named L</sv_len> returns.
+Same as L</av_top_index>. Note that, unlike what the name implies, it returns
+the highest index in the array, so to get the size of the array you need to use
+S<C<av_len(av) + 1>>. This is unlike L</sv_len>, which returns what you would
+expect.
=cut
*/
Set the highest index in the array to the given number, equivalent to
Perl's C<$#array = $fill;>.
-The number of elements in the an array will be C<fill + 1> after
+The number of elements in the array will be C<fill + 1> after
av_fill() returns. If the array was previously shorter, then the
additional elements appended are set to NULL. If the array
was longer, then the excess elements are freed. C<av_fill(av, -1)> is
void
Perl_av_fill(pTHX_ AV *av, SSize_t fill)
{
- dVAR;
MAGIC *mg;
PERL_ARGS_ASSERT_AV_FILL;
SV *
Perl_av_delete(pTHX_ AV *av, SSize_t key, I32 flags)
{
- dVAR;
SV *sv;
PERL_ARGS_ASSERT_AV_DELETE;
if (!AvREAL(av) && AvREIFY(av))
av_reify(av);
sv = AvARRAY(av)[key];
+ AvARRAY(av)[key] = NULL;
if (key == AvFILLp(av)) {
- AvARRAY(av)[key] = NULL;
do {
AvFILLp(av)--;
} while (--key >= 0 && !AvARRAY(av)[key]);
}
- else
- AvARRAY(av)[key] = NULL;
if (SvSMAGICAL(av))
mg_set(MUTABLE_SV(av));
}
- if (flags & G_DISCARD) {
- SvREFCNT_dec(sv);
- sv = NULL;
+ if(sv != NULL) {
+ if (flags & G_DISCARD) {
+ SvREFCNT_dec_NN(sv);
+ return NULL;
+ }
+ else if (AvREAL(av))
+ sv_2mortal(sv);
}
- else if (AvREAL(av))
- sv = sv_2mortal(sv);
return sv;
}
bool
Perl_av_exists(pTHX_ AV *av, SSize_t key)
{
- dVAR;
PERL_ARGS_ASSERT_AV_EXISTS;
assert(SvTYPE(av) == SVt_PVAV);
static MAGIC *
S_get_aux_mg(pTHX_ AV *av) {
- dVAR;
MAGIC *mg;
PERL_ARGS_ASSERT_GET_AUX_MG;