X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/1a3362a5d4e9f2d3548e2937ecf5a9a8a1ac7898..37bf3a91b5a138cf737aab57dff541347d84cb90:/av.c

diff --git a/av.c b/av.c
index 6e08454..e6b9d22 100644
--- a/av.c
+++ b/av.c
@@ -150,11 +150,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
 		assert(newmax >= AvMAX(av));
 		Newx(ary, newmax+1, SV*);
 		Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*);
-		if (AvMAX(av) > 64)
-		    offer_nice_chunk(AvALLOC(av),
-				     (AvMAX(av)+1) * sizeof(const SV *));
-		else
-		    Safefree(AvALLOC(av));
+		Safefree(AvALLOC(av));
 		AvALLOC(av) = ary;
 #endif
 #ifdef Perl_safesysmalloc_size
@@ -199,6 +195,7 @@ See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
 more information on how to use this function on tied arrays. 
 
 The rough perl equivalent is C<$myarray[$idx]>.
+
 =cut
 */
 
@@ -278,11 +275,15 @@ Perl_av_fetch(pTHX_ register 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 to get the original C<SV*>.  Note
-that the caller is responsible for suitably incrementing the reference
+arrays). Otherwise, it can be dereferenced to get the C<SV*> that was stored
+there (= C<val>)).
+
+Note that the caller is responsible for suitably incrementing the reference
 count of C<val> before the call, and decrementing it if the function
 returned NULL.
 
+Approximate Perl equivalent: C<$myarray[$key] = $val;>.
+
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for
 more information on how to use this function on tied arrays.
 
@@ -339,7 +340,7 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
     }
 
     if (SvREADONLY(av) && key >= AvFILL(av))
-	Perl_croak(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify(aTHX);
 
     if (!AvREAL(av) && AvREIFY(av))
 	av_reify(av);
@@ -365,7 +366,7 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
 	    sv_magic(val, MUTABLE_SV(av), toLOWER(mg->mg_type), 0, key);
 	}
 	if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa)
-	    PL_delaymagic |= DM_ARRAY;
+	    PL_delaymagic |= DM_ARRAY_ISA;
 	else
 	   mg_set(MUTABLE_SV(av));
     }
@@ -379,6 +380,8 @@ Creates a new AV and populates it with a list of SVs.  The SVs are copied
 into the array, so they may be freed after the call to av_make.  The new AV
 will have a reference count of 1.
 
+Perl equivalent: C<my @new_array = ($scalar1, $scalar2, $scalar3...);>
+
 =cut
 */
 
@@ -438,13 +441,13 @@ Perl_av_clear(pTHX_ register AV *av)
 #endif
 
     if (SvREADONLY(av))
-	Perl_croak(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify(aTHX);
 
     /* Give any tie a chance to cleanup first */
     if (SvRMAGICAL(av)) {
 	const MAGIC* const mg = SvMAGIC(av);
 	if (PL_delaymagic && mg && mg->mg_type == PERL_MAGIC_isa)
-	    PL_delaymagic |= DM_ARRAY;
+	    PL_delaymagic |= DM_ARRAY_ISA;
         else
 	    mg_clear(MUTABLE_SV(av)); 
     }
@@ -528,8 +531,9 @@ Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val)
 =for apidoc av_push
 
 Pushes an SV onto the end of the array.  The array will grow automatically
-to accommodate the addition. Like C<av_store>, this takes ownership of one
-reference count.
+to accommodate the addition. This takes ownership of one reference count.
+
+Perl equivalent: C<push @myarray, $elem;>.
 
 =cut
 */
@@ -544,7 +548,7 @@ Perl_av_push(pTHX_ register AV *av, SV *val)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-	Perl_croak(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify(aTHX);
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
 	Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1,
@@ -560,6 +564,8 @@ Perl_av_push(pTHX_ register AV *av, SV *val)
 Pops an SV off the end of the array.  Returns C<&PL_sv_undef> if the array
 is empty.
 
+Perl equivalent: C<pop(@myarray);>
+
 =cut
 */
 
@@ -574,7 +580,7 @@ Perl_av_pop(pTHX_ register AV *av)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-	Perl_croak(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify(aTHX);
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
 	retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "POP", 0, 0);
 	if (retval)
@@ -619,6 +625,8 @@ Unshift the given number of C<undef> values onto the beginning of the
 array.  The array will grow automatically to accommodate the addition.  You
 must then use C<av_store> to assign values to these new elements.
 
+Perl equivalent: C<unshift @myarray, ( (undef) x $n );>
+    
 =cut
 */
 
@@ -633,7 +641,7 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-	Perl_croak(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify(aTHX);
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
 	Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "UNSHIFT",
@@ -681,6 +689,8 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
 Shifts an SV off the beginning of the array. Returns C<&PL_sv_undef> if the 
 array is empty.
 
+Perl equivalent: C<shift(@myarray);>
+
 =cut
 */
 
@@ -695,7 +705,7 @@ Perl_av_shift(pTHX_ register AV *av)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-	Perl_croak(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify(aTHX);
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
 	retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "SHIFT", 0, 0);
 	if (retval)
@@ -721,6 +731,8 @@ Perl_av_shift(pTHX_ register AV *av)
 Returns the highest index in the array.  The number of elements in the
 array is C<av_len(av) + 1>.  Returns -1 if the array is empty.
 
+The Perl equivalent for this is C<$#myarray>.
+
 =cut
 */
 
@@ -791,11 +803,11 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
 /*
 =for apidoc av_delete
 
-Deletes the element indexed by C<key> from the array.  Returns the
-deleted element. If C<flags> equals C<G_DISCARD>, the element is freed
-and null is returned. Perl equivalent: C<my $elem = delete($myarray[$idx]);>
-for the non-C<G_DISCARD> version and a void-context C<delete($myarray[$idx]);>
-for the C<G_DISCARD> version.
+Deletes the element indexed by C<key> from the array, makes the element mortal,
+and returns it.  If C<flags> equals C<G_DISCARD>, the element is freed and null
+is returned.  Perl equivalent: C<my $elem = delete($myarray[$idx]);> for the
+non-C<G_DISCARD> version and a void-context C<delete($myarray[$idx]);> for the
+C<G_DISCARD> version.
 
 =cut
 */
@@ -809,7 +821,7 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
     assert(SvTYPE(av) == SVt_PVAV);
 
     if (SvREADONLY(av))
-	Perl_croak(aTHX_ "%s", PL_no_modify);
+	Perl_croak_no_modify(aTHX);
 
     if (SvRMAGICAL(av)) {
         const MAGIC * const tied_magic
@@ -901,7 +913,9 @@ Perl_av_exists(pTHX_ AV *av, I32 key)
     if (SvRMAGICAL(av)) {
         const MAGIC * const tied_magic
 	    = mg_find((const SV *)av, PERL_MAGIC_tied);
-        if (tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata)) {
+        const MAGIC * const regdata_magic
+            = mg_find((const SV *)av, PERL_MAGIC_regdata);
+        if (tied_magic || regdata_magic) {
 	    SV * const sv = sv_newmortal();
             MAGIC *mg;
             /* Handle negative array indices 20020222 MJD */
@@ -920,9 +934,18 @@ Perl_av_exists(pTHX_ AV *av, I32 key)
                     key += AvFILL(av) + 1;
                     if (key < 0)
                         return FALSE;
+                    else
+                        return TRUE;
                 }
             }
 
+            if(key >= 0 && regdata_magic) {
+                if (key <= AvFILL(av))
+                    return TRUE;
+                else
+                    return FALSE;
+            }
+
             mg_copy(MUTABLE_SV(av), sv, 0, key);
             mg = mg_find(sv, PERL_MAGIC_tiedelem);
             if (mg) {