Assimilate Cwd 2.15 from CPAN

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

diff --git a/pp_ctl.c b/pp_ctl.c
index 42d63c6..3c632e2 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -939,8 +939,19 @@ PP(pp_mapwhile)
        }
        /* copy the new items down to the destination list */
        dst = PL_stack_base + (PL_markstack_ptr[-2] += items) - 1;
-       while (items-- > 0)
-           *dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs);
+       if (gimme == G_ARRAY) {
+           while (items-- > 0)
+               *dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs);
+       }
+       else { 
+           /* scalar context: we don't care about which values map returns
+            * (we use undef here). And so we certainly don't want to do mortal
+            * copies of meaningless values. */
+           while (items-- > 0) {
+               POPs;
+               *dst-- = &PL_sv_undef;
+           }
+       }
     }
     LEAVE;                                     /* exit inner scope */
 
@@ -954,8 +965,15 @@ PP(pp_mapwhile)
        (void)POPMARK;                          /* pop dst */
        SP = PL_stack_base + POPMARK;           /* pop original mark */
        if (gimme == G_SCALAR) {
-           dTARGET;
-           XPUSHi(items);
+           if (PL_op->op_private & OPpGREP_LEX) {
+               SV* sv = sv_newmortal();
+               sv_setiv(sv, items);
+               PUSHs(sv);
+           }
+           else {
+               dTARGET;
+               XPUSHi(items);
+           }
        }
        else if (gimme == G_ARRAY)
            SP += items;
@@ -2164,6 +2182,7 @@ PP(pp_goto)
     char *label;
     int do_dump = (PL_op->op_type == OP_DUMP);
     static char must_have_label[] = "goto must have label";
+    AV *oldav = Nullav;
 
     label = 0;
     if (PL_op->op_flags & OPf_STACKED) {
@@ -2224,7 +2243,7 @@ PP(pp_goto)
                GvAV(PL_defgv) = cx->blk_sub.savearray;
                /* abandon @_ if it got reified */
                if (AvREAL(av)) {
-                   (void)sv_2mortal((SV*)av);  /* delay until return */
+                   oldav = av; /* delay until return */
                    av = newAV();
                    av_extend(av, items-1);
                    AvFLAGS(av) = AVf_REIFY;
@@ -2250,6 +2269,9 @@ PP(pp_goto)
 
            /* Now do some callish stuff. */
            SAVETMPS;
+           /* For reified @_, delay freeing till return from new sub */
+           if (oldav)
+               SAVEFREESV((SV*)oldav);
            SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
            if (CvXSUB(cv)) {
 #ifdef PERL_XSUB_OLDSTYLE
@@ -2707,7 +2729,6 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, PAD** padp)
 #else
     SAVEVPTR(PL_op);
 #endif
-    PL_hints &= HINT_UTF8;
 
     /* we get here either during compilation, or via pp_regcomp at runtime */
     runtime = IN_PERL_RUNTIME;