fix parsing of here documents in C<eval 's/.../<<FOO/e'>

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

diff --git a/pp_ctl.c b/pp_ctl.c
index 3263b34..df2a962 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -45,8 +45,8 @@ static I32 sv_ncmp _((SV *a, SV *b));
 static I32 sv_i_ncmp _((SV *a, SV *b));
 static I32 amagic_ncmp _((SV *a, SV *b));
 static I32 amagic_i_ncmp _((SV *a, SV *b));
-I32 amagic_cmp _((SV *str1, SV *str2));
-I32 amagic_cmp_locale _((SV *str1, SV *str2));
+static I32 amagic_cmp _((SV *str1, SV *str2));
+static I32 amagic_cmp_locale _((SV *str1, SV *str2));
 #endif
 
 PP(pp_wantarray)
@@ -826,7 +826,7 @@ amagic_i_ncmp(register SV *a, register SV *b)
     return sv_i_ncmp(a, b);
 }
 
-I32
+STATIC I32
 amagic_cmp(register SV *str1, register SV *str2)
 {
     SV *tmpsv;
@@ -848,7 +848,7 @@ amagic_cmp(register SV *str1, register SV *str2)
     return sv_cmp(str1, str2);
 }
 
-I32
+STATIC I32
 amagic_cmp_locale(register SV *str1, register SV *str2)
 {
     SV *tmpsv;
@@ -1065,22 +1065,30 @@ PP(pp_flop)
 
     if (GIMME == G_ARRAY) {
        dPOPPOPssrl;
-       register I32 i;
+       register I32 i, j;
        register SV *sv;
        I32 max;
 
+       if (SvGMAGICAL(left))
+           mg_get(left);
+       if (SvGMAGICAL(right))
+           mg_get(right);
+
        if (SvNIOKp(left) || !SvPOKp(left) ||
          (looks_like_number(left) && *SvPVX(left) != '0') )
        {
-           if (SvNV(left) < IV_MIN || SvNV(right) >= IV_MAX)
+           if (SvNV(left) < IV_MIN || SvNV(right) > IV_MAX)
                croak("Range iterator outside integer range");
            i = SvIV(left);
            max = SvIV(right);
            if (max >= i) {
-               EXTEND_MORTAL(max - i + 1);
-               EXTEND(SP, max - i + 1);
+               j = max - i + 1;
+               EXTEND_MORTAL(j);
+               EXTEND(SP, j);
            }
-           while (i <= max) {
+           else
+               j = 0;
+           while (j--) {
                sv = sv_2mortal(newSViv(i++));
                PUSHs(sv);
            }
@@ -1640,8 +1648,12 @@ PP(pp_enteriter)
     SAVETMPS;
 
 #ifdef USE_THREADS
-    if (PL_op->op_flags & OPf_SPECIAL)
-       svp = save_threadsv(PL_op->op_targ);    /* per-thread variable */
+    if (PL_op->op_flags & OPf_SPECIAL) {
+       dTHR;
+       svp = &THREADSV(PL_op->op_targ);        /* per-thread variable */
+       SAVEGENERICSV(*svp);
+       *svp = NEWSV(0,0);
+    }
     else
 #endif /* USE_THREADS */
     if (PL_op->op_targ) {
@@ -1649,9 +1661,9 @@ PP(pp_enteriter)
        SAVESPTR(*svp);
     }
     else {
-       GV *gv = (GV*)POPs;
-       (void)save_scalar(gv);
-       svp = &GvSV(gv);                        /* symbol table variable */
+       svp = &GvSV((GV*)POPs);                 /* symbol table variable */
+       SAVEGENERICSV(*svp);
+       *svp = NEWSV(0,0);
     }
 
     ENTER;
@@ -2019,6 +2031,7 @@ PP(pp_goto)
     OP *enterops[GOTO_DEPTH];
     char *label;
     int do_dump = (PL_op->op_type == OP_DUMP);
+    static char must_have_label[] = "goto must have label";
 
     label = 0;
     if (PL_op->op_flags & OPf_STACKED) {
@@ -2272,12 +2285,15 @@ PP(pp_goto)
                RETURNOP(CvSTART(cv));
            }
        }
-       else
+       else {
            label = SvPV(sv,n_a);
+           if (!(do_dump || *label))
+               DIE(must_have_label);
+       }
     }
     else if (PL_op->op_flags & OPf_SPECIAL) {
        if (! do_dump)
-           DIE("goto must have label");
+           DIE(must_have_label);
     }
     else
        label = cPVOP->op_pv;
@@ -2603,7 +2619,7 @@ doeval(int gimme, OP** startop)
     SAVESPTR(PL_compcv);
     PL_compcv = (CV*)NEWSV(1104,0);
     sv_upgrade((SV *)PL_compcv, SVt_PVCV);
-    CvUNIQUE_on(PL_compcv);
+    CvEVAL_on(PL_compcv);
 #ifdef USE_THREADS
     CvOWNER(PL_compcv) = 0;
     New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);