X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/fc16c3924bd6aa054f21ad5445fecf9b7f39dc36..410a87cf53faefde0612c4b86b028c140c5884fe:/av.c diff --git a/av.c b/av.c index 401a61c..53690d5 100644 --- a/av.c +++ b/av.c @@ -26,8 +26,7 @@ void Perl_av_reify(pTHX_ AV *av) { - dVAR; - I32 key; + SSize_t key; PERL_ARGS_ASSERT_AV_REIFY; assert(SvTYPE(av) == SVt_PVAV); @@ -65,7 +64,6 @@ extended. void Perl_av_extend(pTHX_ AV *av, SSize_t key) { - dVAR; MAGIC *mg; PERL_ARGS_ASSERT_AV_EXTEND; @@ -87,8 +85,6 @@ void 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) { @@ -112,11 +108,6 @@ Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp, } } 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 @@ -139,10 +130,34 @@ Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp, 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 @@ -156,7 +171,14 @@ Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp, } 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; @@ -190,7 +212,7 @@ The rough perl equivalent is C<$myarray[$idx]>. */ static bool -S_adjust_index(pTHX_ AV *av, const MAGIC *mg, I32 *keyp) +S_adjust_index(pTHX_ AV *av, const MAGIC *mg, SSize_t *keyp) { bool adjust_index = 1; if (mg) { @@ -201,7 +223,8 @@ S_adjust_index(pTHX_ AV *av, const MAGIC *mg, I32 *keyp) SV * const * const negative_indices_glob = hv_fetchs(SvSTASH(SvRV(ref)), NEGATIVE_INDICES_VAR, 0); - if (negative_indices_glob && SvTRUE(GvSV(*negative_indices_glob))) + if (negative_indices_glob && isGV(*negative_indices_glob) + && SvTRUE(GvSV(*negative_indices_glob))) adjust_index = 0; } } @@ -215,10 +238,8 @@ S_adjust_index(pTHX_ AV *av, const MAGIC *mg, I32 *keyp) } SV** -Perl_av_fetch(pTHX_ AV *av, I32 key, I32 lval) +Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval) { - dVAR; - PERL_ARGS_ASSERT_AV_FETCH; assert(SvTYPE(av) == SVt_PVAV); @@ -269,7 +290,7 @@ Perl_av_fetch(pTHX_ AV *av, I32 key, I32 lval) Stores an SV in an array. The array index is specified as C. 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 that was stored there (= C)). @@ -286,9 +307,8 @@ more information on how to use this function on tied arrays. */ SV** -Perl_av_store(pTHX_ AV *av, I32 key, SV *val) +Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val) { - dVAR; SV** ary; PERL_ARGS_ASSERT_AV_STORE; @@ -372,7 +392,7 @@ Perl equivalent: C */ AV * -Perl_av_make(pTHX_ I32 size, SV **strp) +Perl_av_make(pTHX_ SSize_t size, SV **strp) { AV * const av = MUTABLE_AV(newSV_type(SVt_PVAV)); /* sv_upgrade does AvREAL_only() */ @@ -381,7 +401,7 @@ Perl_av_make(pTHX_ I32 size, SV **strp) if (size) { /* "defined" was returning undef for size==0 anyway. */ SV** ary; - I32 i; + SSize_t i; Newx(ary,size,SV*); AvALLOC(av) = ary; AvARRAY(av) = ary; @@ -424,8 +444,7 @@ Perl equivalent: C<@myarray = ();>. void Perl_av_clear(pTHX_ AV *av) { - dVAR; - I32 extra; + SSize_t extra; bool real; PERL_ARGS_ASSERT_AV_CLEAR; @@ -454,7 +473,7 @@ Perl_av_clear(pTHX_ AV *av) if ((real = !!AvREAL(av))) { SV** const ary = AvARRAY(av); - I32 index = AvFILLp(av) + 1; + SSize_t index = AvFILLp(av) + 1; ENTER; SAVEFREESV(SvREFCNT_inc_simple_NN(av)); while (index) { @@ -497,7 +516,7 @@ Perl_av_undef(pTHX_ AV *av) av_fill(av, -1); if ((real = !!AvREAL(av))) { - I32 key = AvFILLp(av) + 1; + SSize_t key = AvFILLp(av) + 1; ENTER; SAVEFREESV(SvREFCNT_inc_simple_NN(av)); while (key) @@ -547,7 +566,6 @@ Perl equivalent: C. void Perl_av_push(pTHX_ AV *av, SV *val) { - dVAR; MAGIC *mg; PERL_ARGS_ASSERT_AV_PUSH; @@ -579,7 +597,6 @@ Perl equivalent: C SV * Perl_av_pop(pTHX_ AV *av) { - dVAR; SV *retval; MAGIC* mg; @@ -638,10 +655,9 @@ Perl equivalent: C */ void -Perl_av_unshift(pTHX_ AV *av, I32 num) +Perl_av_unshift(pTHX_ AV *av, SSize_t num) { - dVAR; - I32 i; + SSize_t i; MAGIC* mg; PERL_ARGS_ASSERT_AV_UNSHIFT; @@ -672,9 +688,9 @@ Perl_av_unshift(pTHX_ AV *av, I32 num) } if (num) { SV **ary; - const I32 i = AvFILLp(av); + const SSize_t i = AvFILLp(av); /* Create extra elements */ - const I32 slide = i > 0 ? i : 0; + const SSize_t slide = i > 0 ? i : 0; num += slide; av_extend(av, i + num); AvFILLp(av) += num; @@ -705,7 +721,6 @@ Perl equivalent: C SV * Perl_av_shift(pTHX_ AV *av) { - dVAR; SV *retval; MAGIC* mg; @@ -745,14 +760,15 @@ The Perl equivalent for this is C<$#myarray>. =for apidoc av_len -Same as L. 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 returns. +Same as L. 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>. This is unlike L, which returns what you would +expect. =cut */ -I32 +SSize_t Perl_av_len(pTHX_ AV *av) { PERL_ARGS_ASSERT_AV_LEN; @@ -766,7 +782,7 @@ Perl_av_len(pTHX_ AV *av) 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 after +The number of elements in the array will be C 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 is @@ -775,9 +791,8 @@ the same as C. =cut */ void -Perl_av_fill(pTHX_ AV *av, I32 fill) +Perl_av_fill(pTHX_ AV *av, SSize_t fill) { - dVAR; MAGIC *mg; PERL_ARGS_ASSERT_AV_FILL; @@ -793,7 +808,7 @@ Perl_av_fill(pTHX_ AV *av, I32 fill) return; } if (fill <= AvMAX(av)) { - I32 key = AvFILLp(av); + SSize_t key = AvFILLp(av); SV** const ary = AvARRAY(av); if (AvREAL(av)) { @@ -827,9 +842,8 @@ C version. =cut */ SV * -Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags) +Perl_av_delete(pTHX_ AV *av, SSize_t key, I32 flags) { - dVAR; SV *sv; PERL_ARGS_ASSERT_AV_DELETE; @@ -872,23 +886,23 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags) 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; } @@ -905,9 +919,8 @@ Perl equivalent: C. =cut */ bool -Perl_av_exists(pTHX_ AV *av, I32 key) +Perl_av_exists(pTHX_ AV *av, SSize_t key) { - dVAR; PERL_ARGS_ASSERT_AV_EXISTS; assert(SvTYPE(av) == SVt_PVAV); @@ -961,7 +974,6 @@ Perl_av_exists(pTHX_ AV *av, I32 key) static MAGIC * S_get_aux_mg(pTHX_ AV *av) { - dVAR; MAGIC *mg; PERL_ARGS_ASSERT_GET_AUX_MG;