Change Perl_av_iter_p() to return IV* rather than I32* (which means

[p5sagit/p5-mst-13.2.git] / pp.c

diff --git a/pp.c b/pp.c
index 6d69589..937b7ce 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -172,13 +172,7 @@ PP(pp_rv2gv)
                        const char * const name = CopSTASHPV(PL_curcop);
                        gv = newGVgen(name);
                    }
-                   if (SvTYPE(sv) < SVt_RV)
-                       sv_upgrade(sv, SVt_RV);
-                   else if (SvPVX_const(sv)) {
-                       SvPV_free(sv);
-                       SvLEN_set(sv, 0);
-                        SvCUR_set(sv, 0);
-                   }
+                   prepare_SV_for_RV(sv);
                    SvRV_set(sv, (SV*)gv);
                    SvROK_on(sv);
                    SvSETMAGIC(sv);
@@ -536,7 +530,7 @@ S_refto(pTHX_ SV *sv)
        SvREFCNT_inc_void_NN(sv);
     }
     rv = sv_newmortal();
-    sv_upgrade(rv, SVt_RV);
+    sv_upgrade(rv, SVt_IV);
     SvRV_set(rv, sv);
     SvROK_on(rv);
     return rv;
@@ -3929,6 +3923,67 @@ PP(pp_aslice)
     RETURN;
 }
 
+PP(pp_aeach)
+{
+    dVAR;
+    dSP;
+    AV *array = (AV*)POPs;
+    const I32 gimme = GIMME_V;
+    IV *iterp = Perl_av_iter_p(aTHX_ array);
+    const IV current = (*iterp)++;
+
+    if (current > av_len(array)) {
+       *iterp = 0;
+       if (gimme == G_SCALAR)
+           RETPUSHUNDEF;
+       else
+           RETURN;
+    }
+
+    EXTEND(SP, 2);
+    mPUSHi(CopARYBASE_get(PL_curcop) + current);
+    if (gimme == G_ARRAY) {
+       SV **const element = av_fetch(array, current, 0);
+        PUSHs(element ? *element : &PL_sv_undef);
+    }
+    RETURN;
+}
+
+PP(pp_akeys)
+{
+    dVAR;
+    dSP;
+    AV *array = (AV*)POPs;
+    const I32 gimme = GIMME_V;
+
+    *Perl_av_iter_p(aTHX_ array) = 0;
+
+    if (gimme == G_SCALAR) {
+       dTARGET;
+       PUSHi(av_len(array) + 1);
+    }
+    else if (gimme == G_ARRAY) {
+        IV n = Perl_av_len(aTHX_ array);
+        IV i = CopARYBASE_get(PL_curcop);
+
+        EXTEND(SP, n + 1);
+
+       if (PL_op->op_type == OP_AKEYS) {
+           n += i;
+           for (;  i <= n;  i++) {
+               mPUSHi(i);
+           }
+       }
+       else {
+           for (i = 0;  i <= n;  i++) {
+               SV *const *const elem = Perl_av_fetch(aTHX_ array, i, 0);
+               PUSHs(elem ? *elem : &PL_sv_undef);
+           }
+       }
+    }
+    RETURN;
+}
+
 /* Associative arrays. */
 
 PP(pp_each)