This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/op/taint.t: Perform SHA-256 algorithm by crypt() if default one is disabled
[perl5.git] / av.c
diff --git a/av.c b/av.c
index 401a61c..0029191 100644 (file)
--- a/av.c
+++ b/av.c
@@ -26,8 +26,7 @@
 void
 Perl_av_reify(pTHX_ AV *av)
 {
 void
 Perl_av_reify(pTHX_ AV *av)
 {
-    dVAR;
-    I32 key;
+    SSize_t key;
 
     PERL_ARGS_ASSERT_AV_REIFY;
     assert(SvTYPE(av) == SVt_PVAV);
 
     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)
 {
 void
 Perl_av_extend(pTHX_ AV *av, SSize_t key)
 {
-    dVAR;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_AV_EXTEND;
     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)
 {
 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) {
     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 {
            }
        }
        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 (*allocp) {
 
 #ifdef Perl_safesysmalloc_size
@@ -141,8 +132,23 @@ Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp,
 #endif 
                newmax = key + *maxp / 5;
              resize:
 #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*);
                Renew(*allocp,newmax+1, SV*);
+#endif
 #ifdef Perl_safesysmalloc_size
              resized:
 #endif
 #ifdef Perl_safesysmalloc_size
              resized:
 #endif
@@ -156,7 +162,13 @@ Perl_av_extend_guts(pTHX_ AV *av, SSize_t key, SSize_t *maxp, SV ***allocp,
            }
            else {
                newmax = key < 3 ? 3 : key;
            }
            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;
                Newx(*allocp, newmax+1, SV*);
                ary = *allocp + 1;
                tmp = newmax;
@@ -190,7 +202,7 @@ The rough perl equivalent is C<$myarray[$idx]>.
 */
 
 static bool
 */
 
 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) {
 {
     bool adjust_index = 1;
     if (mg) {
@@ -201,7 +213,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);
 
            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;
        }
     }
                adjust_index = 0;
        }
     }
@@ -215,10 +228,8 @@ S_adjust_index(pTHX_ AV *av, const MAGIC *mg, I32 *keyp)
 }
 
 SV**
 }
 
 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);
 
     PERL_ARGS_ASSERT_AV_FETCH;
     assert(SvTYPE(av) == SVt_PVAV);
 
@@ -269,7 +280,7 @@ Perl_av_fetch(pTHX_ AV *av, I32 key, I32 lval)
 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
 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>)).
 
 to get the C<SV*> that was stored
 there (= C<val>)).
 
@@ -286,9 +297,8 @@ more information on how to use this function on tied arrays.
 */
 
 SV**
 */
 
 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;
     SV** ary;
 
     PERL_ARGS_ASSERT_AV_STORE;
@@ -372,7 +382,7 @@ Perl equivalent: C<my @new_array = ($scalar1, $scalar2, $scalar3...);>
 */
 
 AV *
 */
 
 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()  */
 {
     AV * const av = MUTABLE_AV(newSV_type(SVt_PVAV));
     /* sv_upgrade does AvREAL_only()  */
@@ -381,7 +391,7 @@ Perl_av_make(pTHX_ I32 size, SV **strp)
 
     if (size) {                /* "defined" was returning undef for size==0 anyway. */
         SV** ary;
 
     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;
        Newx(ary,size,SV*);
        AvALLOC(av) = ary;
        AvARRAY(av) = ary;
@@ -424,8 +434,7 @@ Perl equivalent: C<@myarray = ();>.
 void
 Perl_av_clear(pTHX_ AV *av)
 {
 void
 Perl_av_clear(pTHX_ AV *av)
 {
-    dVAR;
-    I32 extra;
+    SSize_t extra;
     bool real;
 
     PERL_ARGS_ASSERT_AV_CLEAR;
     bool real;
 
     PERL_ARGS_ASSERT_AV_CLEAR;
@@ -454,7 +463,7 @@ Perl_av_clear(pTHX_ AV *av)
 
     if ((real = !!AvREAL(av))) {
        SV** const ary = AvARRAY(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) {
        ENTER;
        SAVEFREESV(SvREFCNT_inc_simple_NN(av));
        while (index) {
@@ -497,7 +506,7 @@ Perl_av_undef(pTHX_ AV *av)
        av_fill(av, -1);
 
     if ((real = !!AvREAL(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)
        ENTER;
        SAVEFREESV(SvREFCNT_inc_simple_NN(av));
        while (key)
@@ -547,7 +556,6 @@ Perl equivalent: C<push @myarray, $elem;>.
 void
 Perl_av_push(pTHX_ AV *av, SV *val)
 {             
 void
 Perl_av_push(pTHX_ AV *av, SV *val)
 {             
-    dVAR;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_AV_PUSH;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_AV_PUSH;
@@ -579,7 +587,6 @@ Perl equivalent: C<pop(@myarray);>
 SV *
 Perl_av_pop(pTHX_ AV *av)
 {
 SV *
 Perl_av_pop(pTHX_ AV *av)
 {
-    dVAR;
     SV *retval;
     MAGIC* mg;
 
     SV *retval;
     MAGIC* mg;
 
@@ -638,10 +645,9 @@ Perl equivalent: C<unshift @myarray, ( (undef) x $n );>
 */
 
 void
 */
 
 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;
     MAGIC* mg;
 
     PERL_ARGS_ASSERT_AV_UNSHIFT;
@@ -672,9 +678,9 @@ Perl_av_unshift(pTHX_ AV *av, I32 num)
     }
     if (num) {
        SV **ary;
     }
     if (num) {
        SV **ary;
-       const I32 i = AvFILLp(av);
+       const SSize_t i = AvFILLp(av);
        /* Create extra elements */
        /* 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;
        num += slide;
        av_extend(av, i + num);
        AvFILLp(av) += num;
@@ -705,7 +711,6 @@ Perl equivalent: C<shift(@myarray);>
 SV *
 Perl_av_shift(pTHX_ AV *av)
 {
 SV *
 Perl_av_shift(pTHX_ AV *av)
 {
-    dVAR;
     SV *retval;
     MAGIC* mg;
 
     SV *retval;
     MAGIC* mg;
 
@@ -743,16 +748,21 @@ The Perl equivalent for this is C<$#myarray>.
 
 (A slightly shorter form is C<av_tindex>.)
 
 
 (A slightly shorter form is C<av_tindex>.)
 
+=for apidoc av_tindex
+
+Same as L</av_top_index>.
+
 =for apidoc av_len
 
 =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
 */
 
 
 =cut
 */
 
-I32
+SSize_t
 Perl_av_len(pTHX_ AV *av)
 {
     PERL_ARGS_ASSERT_AV_LEN;
 Perl_av_len(pTHX_ AV *av)
 {
     PERL_ARGS_ASSERT_AV_LEN;
@@ -766,7 +776,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;>.
 
 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
 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
@@ -775,9 +785,8 @@ the same as C<av_clear(av)>.
 =cut
 */
 void
 =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;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_AV_FILL;
@@ -793,7 +802,7 @@ Perl_av_fill(pTHX_ AV *av, I32 fill)
        return;
     }
     if (fill <= AvMAX(av)) {
        return;
     }
     if (fill <= AvMAX(av)) {
-       I32 key = AvFILLp(av);
+       SSize_t key = AvFILLp(av);
        SV** const ary = AvARRAY(av);
 
        if (AvREAL(av)) {
        SV** const ary = AvARRAY(av);
 
        if (AvREAL(av)) {
@@ -827,9 +836,8 @@ C<G_DISCARD> version.
 =cut
 */
 SV *
 =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;
     SV *sv;
 
     PERL_ARGS_ASSERT_AV_DELETE;
@@ -872,23 +880,23 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
        if (!AvREAL(av) && AvREIFY(av))
            av_reify(av);
        sv = AvARRAY(av)[key];
        if (!AvREAL(av) && AvREIFY(av))
            av_reify(av);
        sv = AvARRAY(av)[key];
+       AvARRAY(av)[key] = NULL;
        if (key == AvFILLp(av)) {
        if (key == AvFILLp(av)) {
-           AvARRAY(av)[key] = NULL;
            do {
                AvFILLp(av)--;
            } while (--key >= 0 && !AvARRAY(av)[key]);
        }
            do {
                AvFILLp(av)--;
            } while (--key >= 0 && !AvARRAY(av)[key]);
        }
-       else
-           AvARRAY(av)[key] = NULL;
        if (SvSMAGICAL(av))
            mg_set(MUTABLE_SV(av));
     }
        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;
 }
 
     return sv;
 }
 
@@ -905,9 +913,8 @@ Perl equivalent: C<exists($myarray[$key])>.
 =cut
 */
 bool
 =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);
 
     PERL_ARGS_ASSERT_AV_EXISTS;
     assert(SvTYPE(av) == SVt_PVAV);
 
@@ -961,7 +968,6 @@ Perl_av_exists(pTHX_ AV *av, I32 key)
 
 static MAGIC *
 S_get_aux_mg(pTHX_ AV *av) {
 
 static MAGIC *
 S_get_aux_mg(pTHX_ AV *av) {
-    dVAR;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_GET_AUX_MG;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_GET_AUX_MG;