This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
honoring void context for map()
[perl5.git] / pp_ctl.c
index 242253b..3339548 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -676,6 +676,7 @@ PP(pp_formline)
                    s++;
            }
            sv_chop(sv,s);
+           SvSETMAGIC(sv);
            break;
 
        case FF_LINEGLOB:
@@ -892,6 +893,7 @@ PP(pp_mapstart)
 PP(pp_mapwhile)
 {
     dSP;
+    I32 gimme = GIMME_V;
     I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */
     I32 count;
     I32 shift;
@@ -902,7 +904,7 @@ PP(pp_mapwhile)
     ++PL_markstack_ptr[-1];
 
     /* if there are new items, push them into the destination list */
-    if (items) {
+    if (items && gimme != G_VOID) {
        /* might need to make room back there first */
        if (items > PL_markstack_ptr[-1] - PL_markstack_ptr[-2]) {
            /* XXX this implementation is very pessimal because the stack
@@ -946,7 +948,6 @@ PP(pp_mapwhile)
 
     /* All done yet? */
     if (PL_markstack_ptr[-1] > *PL_markstack_ptr) {
-       I32 gimme = GIMME_V;
 
        (void)POPMARK;                          /* pop top */
        LEAVE;                                  /* exit outer scope */
@@ -1730,6 +1731,11 @@ PP(pp_enteriter)
     SAVETMPS;
 
     if (PL_op->op_targ) {
+       if (PL_op->op_private & OPpLVAL_INTRO) { /* for my $x (...) */
+           SvPADSTALE_off(PAD_SVl(PL_op->op_targ));
+           SAVESETSVFLAGS(PAD_SVl(PL_op->op_targ),
+                   SVs_PADSTALE, SVs_PADSTALE);
+       }
 #ifndef USE_ITHREADS
        svp = &PAD_SVl(PL_op->op_targ);         /* "my" variable */
        SAVESPTR(*svp);
@@ -1877,6 +1883,7 @@ PP(pp_return)
     switch (CxTYPE(cx)) {
     case CXt_SUB:
        popsub2 = TRUE;
+       cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
        break;
     case CXt_EVAL:
        if (!(PL_in_eval & EVAL_KEEPERR))
@@ -1939,6 +1946,7 @@ PP(pp_return)
     LEAVE;
     /* Stack values are safe: */
     if (popsub2) {
+       cxstack_ix--;
        POPSUB(cx,sv);  /* release CV and @_ ... */
     }
     else
@@ -1979,6 +1987,7 @@ PP(pp_last)
        dounwind(cxix);
 
     POPBLOCK(cx,newpm);
+    cxstack_ix++; /* temporarily protect top context */
     mark = newsp;
     switch (CxTYPE(cx)) {
     case CXt_LOOP:
@@ -2021,6 +2030,7 @@ PP(pp_last)
     PUTBACK;
 
     LEAVE;
+    cxstack_ix--;
     /* Stack values are safe: */
     switch (pop2) {
     case CXt_LOOP:
@@ -2334,7 +2344,10 @@ PP(pp_goto)
                    CV *gotocv;
                
                    if (PERLDB_SUB_NN) {
-                       SvIVX(sv) = PTR2IV(cv); /* Already upgraded, saved */
+                       (void)SvUPGRADE(sv, SVt_PVIV);
+                       (void)SvIOK_on(sv);
+                       SAVEIV(SvIVX(sv));
+                       SvIVX(sv) = PTR2IV(cv); /* Do it the quickest way */
                    } else {
                        save_item(sv);
                        gv_efullname3(sv, CvGV(cv), Nullch);