Clarify the av_fetch() documentation.

[perl5.git] / av.c

diff --git a/av.c b/av.c
index a4d6ea2..06dc606 100644 (file)
--- a/av.c
+++ b/av.c
@@ -74,19 +74,10 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
 
     mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied);
     if (mg) {
-       dSP;
-       ENTER;
-       SAVETMPS;
-       PUSHSTACKi(PERLSI_MAGIC);
-       PUSHMARK(SP);
-       EXTEND(SP,2);
-       PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-       mPUSHi(key + 1);
-        PUTBACK;
-       call_method("EXTEND", G_SCALAR|G_DISCARD);
-       POPSTACK;
-       FREETMPS;
-       LEAVE;
+       SV *arg1 = sv_newmortal();
+       sv_setiv(arg1, (IV)(key + 1));
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1,
+                           arg1);
        return;
     }
     if (key > AvMAX(av)) {
@@ -200,12 +191,14 @@ 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
 */
 
@@ -245,6 +238,8 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
             sv = sv_newmortal();
            sv_upgrade(sv, SVt_PVLV);
            mg_copy(MUTABLE_SV(av), sv, 0, key);
+           if (!tied_magic) /* for regdata, force leavesub to make copies */
+               SvTEMP_off(sv);
            LvTYPE(sv) = 't';
            LvTARG(sv) = sv; /* fake (SV**) */
            return &(LvTARG(sv));
@@ -422,7 +417,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
 */
@@ -552,17 +547,8 @@ Perl_av_push(pTHX_ register AV *av, SV *val)
        Perl_croak(aTHX_ "%s", PL_no_modify);
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       dSP;
-       PUSHSTACKi(PERLSI_MAGIC);
-       PUSHMARK(SP);
-       EXTEND(SP,2);
-       PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-       PUSHs(val);
-       PUTBACK;
-       ENTER;
-       call_method("PUSH", G_SCALAR|G_DISCARD);
-       LEAVE;
-       POPSTACK;
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1,
+                           val);
        return;
     }
     av_store(av,AvFILLp(av)+1,val);
@@ -590,19 +576,9 @@ Perl_av_pop(pTHX_ register AV *av)
     if (SvREADONLY(av))
        Perl_croak(aTHX_ "%s", PL_no_modify);
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       dSP;    
-       PUSHSTACKi(PERLSI_MAGIC);
-       PUSHMARK(SP);
-       XPUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-       PUTBACK;
-       ENTER;
-       if (call_method("POP", G_SCALAR)) {
-           retval = newSVsv(*PL_stack_sp--);    
-       } else {    
-           retval = &PL_sv_undef;
-       }
-       LEAVE;
-       POPSTACK;
+       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "POP", 0, 0);
+       if (retval)
+           retval = newSVsv(retval);
        return retval;
     }
     if (AvFILL(av) < 0)
@@ -660,19 +636,8 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
        Perl_croak(aTHX_ "%s", PL_no_modify);
 
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       dSP;
-       PUSHSTACKi(PERLSI_MAGIC);
-       PUSHMARK(SP);
-       EXTEND(SP,1+num);
-       PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-       while (num-- > 0) {
-           PUSHs(&PL_sv_undef);
-       }
-       PUTBACK;
-       ENTER;
-       call_method("UNSHIFT", G_SCALAR|G_DISCARD);
-       LEAVE;
-       POPSTACK;
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "UNSHIFT",
+                           G_DISCARD | G_UNDEF_FILL, num);
        return;
     }
 
@@ -732,19 +697,9 @@ Perl_av_shift(pTHX_ register AV *av)
     if (SvREADONLY(av))
        Perl_croak(aTHX_ "%s", PL_no_modify);
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       dSP;
-       PUSHSTACKi(PERLSI_MAGIC);
-       PUSHMARK(SP);
-       XPUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-       PUTBACK;
-       ENTER;
-       if (call_method("SHIFT", G_SCALAR)) {
-           retval = newSVsv(*PL_stack_sp--);            
-       } else {    
-           retval = &PL_sv_undef;
-       }     
-       LEAVE;
-       POPSTACK;
+       retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "SHIFT", 0, 0);
+       if (retval)
+           retval = newSVsv(retval);
        return retval;
     }
     if (AvFILL(av) < 0)
@@ -804,19 +759,10 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
     if (fill < 0)
        fill = -1;
     if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
-       dSP;            
-       ENTER;
-       SAVETMPS;
-       PUSHSTACKi(PERLSI_MAGIC);
-       PUSHMARK(SP);
-       EXTEND(SP,2);
-       PUSHs(SvTIED_obj(MUTABLE_SV(av), mg));
-       mPUSHi(fill + 1);
-       PUTBACK;
-       call_method("STORESIZE", G_SCALAR|G_DISCARD);
-       POPSTACK;
-       FREETMPS;
-       LEAVE;
+       SV *arg1 = sv_newmortal();
+       sv_setiv(arg1, (IV)(fill + 1));
+       Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD,
+                           1, arg1);
        return;
     }
     if (fill <= AvMAX(av)) {
@@ -847,7 +793,9 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
 
 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.
+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
 */
@@ -939,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
@@ -977,7 +927,7 @@ Perl_av_exists(pTHX_ AV *av, I32 key)
             mg = mg_find(sv, PERL_MAGIC_tiedelem);
             if (mg) {
                 magic_existspack(sv, mg);
-                return (bool)SvTRUE(sv);
+                return cBOOL(SvTRUE(sv));
             }
 
         }