This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
TODO some of the new sigdispatch tests on VMS.
[perl5.git] / av.c
diff --git a/av.c b/av.c
index 86aaae0..776dafd 100644 (file)
--- 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
@@ -530,8 +526,7 @@ 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.
 
 =cut
 */
@@ -795,11 +790,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
 */
@@ -905,7 +900,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 */
@@ -924,9 +921,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) {