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)
 {
-    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
@@ -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:
-               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 +162,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 +202,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 +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);
 
-           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 +228,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 +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
-arrays). Otherwise, it can be dereferenced
+arrays).  Otherwise, it can be dereferenced
 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**
-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 +382,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 +391,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 +434,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 +463,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 +506,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 +556,6 @@ Perl equivalent: C<push @myarray, $elem;>.
 void
 Perl_av_push(pTHX_ AV *av, SV *val)
 {             
-    dVAR;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_AV_PUSH;
@@ -579,7 +587,6 @@ Perl equivalent: C<pop(@myarray);>
 SV *
 Perl_av_pop(pTHX_ AV *av)
 {
-    dVAR;
     SV *retval;
     MAGIC* mg;
 
@@ -638,10 +645,9 @@ 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 +678,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 +711,6 @@ Perl equivalent: C<shift(@myarray);>
 SV *
 Perl_av_shift(pTHX_ AV *av)
 {
-    dVAR;
     SV *retval;
     MAGIC* mg;
 
@@ -743,16 +748,21 @@ The Perl equivalent for this is C<$#myarray>.
 
 (A slightly shorter form is C<av_tindex>.)
 
+=for apidoc av_tindex
+
+Same as L</av_top_index>.
+
 =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
 */
 
-I32
+SSize_t
 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;>.
 
-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
@@ -775,9 +785,8 @@ 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;
 
     PERL_ARGS_ASSERT_AV_FILL;
@@ -793,7 +802,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 +836,8 @@ 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;
 
     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];
+       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 +913,8 @@ 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;
     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) {
-    dVAR;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_GET_AUX_MG;