This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Increase $constant::VERSION to 1.31
[perl5.git] / av.c
diff --git a/av.c b/av.c
index 401a61c..d5dda54 100644 (file)
--- a/av.c
+++ b/av.c
@@ -27,7 +27,7 @@ void
 Perl_av_reify(pTHX_ AV *av)
 {
     dVAR;
-    I32 key;
+    SSize_t key;
 
     PERL_ARGS_ASSERT_AV_REIFY;
     assert(SvTYPE(av) == SVt_PVAV);
@@ -112,11 +112,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
@@ -141,8 +136,23 @@ Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp,
 #endif 
                newmax = key + *maxp / 5;
              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
+                   MEM_WRAP_CHECK_1(newmax+1, 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 +166,13 @@ 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
+                   MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
+               }
                Newx(*allocp, newmax+1, SV*);
                ary = *allocp + 1;
                tmp = newmax;
@@ -190,7 +206,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 +217,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,7 +232,7 @@ 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;
 
@@ -286,7 +303,7 @@ 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;
@@ -372,7 +389,7 @@ Perl equivalent: C<my @new_array = ($scalar1, $scalar2, $scalar3...);>
 */
 
 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 +398,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;
@@ -425,7 +442,7 @@ void
 Perl_av_clear(pTHX_ AV *av)
 {
     dVAR;
-    I32 extra;
+    SSize_t extra;
     bool real;
 
     PERL_ARGS_ASSERT_AV_CLEAR;
@@ -454,7 +471,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 +514,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)
@@ -638,10 +655,10 @@ Perl equivalent: C<unshift @myarray, ( (undef) x $n );>
 */
 
 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 +689,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;
@@ -752,7 +769,7 @@ meaning from what the similarly named L</sv_len> returns.
 =cut
 */
 
-I32
+SSize_t
 Perl_av_len(pTHX_ AV *av)
 {
     PERL_ARGS_ASSERT_AV_LEN;
@@ -775,7 +792,7 @@ the same as C<av_clear(av)>.
 =cut
 */
 void
-Perl_av_fill(pTHX_ AV *av, I32 fill)
+Perl_av_fill(pTHX_ AV *av, SSize_t fill)
 {
     dVAR;
     MAGIC *mg;
@@ -793,7 +810,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,7 +844,7 @@ C<G_DISCARD> 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;
@@ -905,7 +922,7 @@ Perl equivalent: C<exists($myarray[$key])>.
 =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;