av.c: Add blank line before =cut

[perl5.git] / av.c

diff --git a/av.c b/av.c
index acedd00..9dd4a76 100644 (file)
--- a/av.c
+++ b/av.c
@@ -76,7 +76,8 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
     if (mg) {
        SV *arg1 = sv_newmortal();
        sv_setiv(arg1, (IV)(key + 1));
-       magic_methcall(MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1, arg1, NULL);
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1,
+                           arg1);
        return;
     }
     if (key > AvMAX(av)) {
@@ -149,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
@@ -190,12 +187,15 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
 =for apidoc av_fetch
 
 Returns the SV at the specified index in the array.  The C<key> is the
-index.  If C<lval> is set then the fetch will be part of a store.  Check
-that the return value is non-null before dereferencing it to a C<SV*>.
+index.  If lval is true, you are guaranteed to get a real SV back (in case
+it wasn't real before), which you can then modify.  Check that the return
+value is non-null before dereferencing it to a C<SV*>.
 
 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
 */
 
@@ -336,7 +336,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);
@@ -362,7 +362,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));
     }
@@ -376,6 +376,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
 */
 
@@ -414,7 +416,7 @@ Perl_av_make(pTHX_ register I32 size, register SV **strp)
 =for apidoc av_clear
 
 Clears an array, making it empty.  Does not free the memory used by the
-array itself.
+array itself. Perl equivalent: C<@myarray = ();>.
 
 =cut
 */
@@ -435,13 +437,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)); 
     }
@@ -525,8 +527,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
 */
@@ -541,10 +542,11 @@ 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))) {
-       magic_methcall(MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1, val, NULL);
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1,
+                           val);
        return;
     }
     av_store(av,AvFILLp(av)+1,val);
@@ -570,9 +572,9 @@ 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 = magic_methcall(MUTABLE_SV(av), mg, "POP", 0, 0, NULL, NULL);
+       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "POP", 0, 0);
        if (retval)
            retval = newSVsv(retval);
        return retval;
@@ -629,11 +631,11 @@ 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))) {
-       magic_methcall(MUTABLE_SV(av), mg, "UNSHIFT", G_DISCARD | G_UNDEF_FILL,
-                      num, NULL, NULL);
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "UNSHIFT",
+                           G_DISCARD | G_UNDEF_FILL, num);
        return;
     }
 
@@ -691,9 +693,9 @@ 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 = magic_methcall(MUTABLE_SV(av), mg, "SHIFT", 0, 0, NULL, NULL);
+       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "SHIFT", 0, 0);
        if (retval)
            retval = newSVsv(retval);
        return retval;
@@ -717,6 +719,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
 */
 
@@ -736,7 +740,7 @@ 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
-av_fill() returns.  If the array was previously shorter then the
+av_fill() returns.  If the array was previously shorter, then the
 additional elements appended are set to C<PL_sv_undef>.  If the array
 was longer, then the excess elements are freed.  C<av_fill(av, -1)> is
 the same as C<av_clear(av)>.
@@ -757,8 +761,8 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
        SV *arg1 = sv_newmortal();
        sv_setiv(arg1, (IV)(fill + 1));
-       magic_methcall(MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD,
-               1, arg1, NULL);
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD,
+                           1, arg1);
        return;
     }
     if (fill <= AvMAX(av)) {
@@ -787,9 +791,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.
+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
 */
@@ -803,7 +809,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
@@ -881,6 +887,8 @@ Returns true if the element indexed by C<key> has been initialized.
 This relies on the fact that uninitialized array elements are set to
 C<&PL_sv_undef>.
 
+Perl equivalent: C<exists($myarray[$key])>.
+
 =cut
 */
 bool
@@ -893,7 +901,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 */
@@ -912,9 +922,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) {