Newer Sun C compilers are not 'SUNwspro', but 'solstudio'.

[perl5.git] / av.c

diff --git a/av.c b/av.c
index 3473d08..49fef00 100644 (file)
--- a/av.c
+++ b/av.c
@@ -26,7 +26,6 @@
 void
 Perl_av_reify(pTHX_ AV *av)
 {
 void
 Perl_av_reify(pTHX_ AV *av)
 {

-    dVAR;

     SSize_t key;
 
     PERL_ARGS_ASSERT_AV_REIFY;
     SSize_t key;
 
     PERL_ARGS_ASSERT_AV_REIFY;


@@ -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;


@@ -201,7 +213,8 @@ S_adjust_index(pTHX_ AV *av, const MAGIC *mg, SSize_t *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;
        }
     }


@@ -217,8 +230,6 @@ S_adjust_index(pTHX_ AV *av, const MAGIC *mg, SSize_t *keyp)
 SV**
 Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval)
 {
 SV**
 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, SSize_t 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>)).
 


@@ -288,7 +299,6 @@ more information on how to use this function on tied arrays.
 SV**
 Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val)
 {
 SV**
 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;


@@ -424,7 +434,6 @@ Perl equivalent: C<@myarray = ();>.
 void
 Perl_av_clear(pTHX_ AV *av)
 {
 void
 Perl_av_clear(pTHX_ AV *av)
 {

-    dVAR;

     SSize_t extra;
     bool real;
 
     SSize_t extra;
     bool real;
 


@@ -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;
 


@@ -640,7 +647,6 @@ Perl equivalent: C<unshift @myarray, ( (undef) x $n );>
 void
 Perl_av_unshift(pTHX_ AV *av, SSize_t num)
 {
 void
 Perl_av_unshift(pTHX_ AV *av, SSize_t num)
 {

-    dVAR;

     SSize_t i;
     MAGIC* mg;
 
     SSize_t i;
     MAGIC* mg;
 


@@ -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,11 +748,16 @@ 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
 */


@@ -777,7 +787,6 @@ the same as C<av_clear(av)>.
 void
 Perl_av_fill(pTHX_ AV *av, SSize_t fill)
 {
 void
 Perl_av_fill(pTHX_ AV *av, SSize_t fill)
 {

-    dVAR;

     MAGIC *mg;
 
     PERL_ARGS_ASSERT_AV_FILL;
     MAGIC *mg;
 
     PERL_ARGS_ASSERT_AV_FILL;


@@ -829,7 +838,6 @@ C<G_DISCARD> version.
 SV *
 Perl_av_delete(pTHX_ AV *av, SSize_t key, I32 flags)
 {
 SV *
 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, SSize_t 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;
 }
 


@@ -907,7 +915,6 @@ Perl equivalent: C<exists($myarray[$key])>.
 bool
 Perl_av_exists(pTHX_ AV *av, SSize_t key)
 {
 bool
 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, SSize_t 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;