INSTALL patches

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

diff --git a/pp_ctl.c b/pp_ctl.c
index e0b65e3..0beaea9 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1,6 +1,6 @@
 /*    pp_ctl.c
  *
- *    Copyright (c) 1991-1997, Larry Wall
+ *    Copyright (c) 1991-1999, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -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);
            }
@@ -1311,7 +1319,7 @@ dounwind(I32 cxix)
 }
 
 OP *
-die_where(char *message)
+die_where(char *message, STRLEN msglen)
 {
     dSP;
     STRLEN n_a;
@@ -1324,9 +1332,8 @@ die_where(char *message)
        if (message) {
            if (PL_in_eval & 4) {
                SV **svp;
-               STRLEN klen = strlen(message);
                
-               svp = hv_fetch(ERRHV, message, klen, TRUE);
+               svp = hv_fetch(ERRHV, message, msglen, TRUE);
                if (svp) {
                    if (!SvIOK(*svp)) {
                        static char prefix[] = "\t(in cleanup) ";
@@ -1335,11 +1342,11 @@ die_where(char *message)
                        (void)SvIOK_only(*svp);
                        if (!SvPOK(err))
                            sv_setpv(err,"");
-                       SvGROW(err, SvCUR(err)+sizeof(prefix)+klen);
+                       SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen);
                        sv_catpvn(err, prefix, sizeof(prefix)-1);
-                       sv_catpvn(err, message, klen);
+                       sv_catpvn(err, message, msglen);
                        if (ckWARN(WARN_UNSAFE)) {
-                           STRLEN start = SvCUR(err)-klen-sizeof(prefix)+1;
+                           STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
                            warner(WARN_UNSAFE, SvPVX(err)+start);
                        }
                    }
@@ -1347,10 +1354,10 @@ die_where(char *message)
                }
            }
            else
-               sv_setpv(ERRSV, message);
+               sv_setpvn(ERRSV, message, msglen);
        }
        else
-           message = SvPVx(ERRSV, n_a);
+           message = SvPVx(ERRSV, msglen);
 
        while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) {
            dounwind(-1);
@@ -1365,7 +1372,8 @@ die_where(char *message)
 
            POPBLOCK(cx,PL_curpm);
            if (CxTYPE(cx) != CXt_EVAL) {
-               PerlIO_printf(PerlIO_stderr(), "panic: die %s", message);
+               PerlIO_write(PerlIO_stderr(), "panic: die ", 11);
+               PerlIO_write(PerlIO_stderr(), message, msglen);
                my_exit(1);
            }
            POPEVAL(cx);
@@ -1384,9 +1392,18 @@ die_where(char *message)
        }
     }
     if (!message)
-       message = SvPVx(ERRSV, n_a);
-    PerlIO_printf(PerlIO_stderr(), "%s",message);
-    PerlIO_flush(PerlIO_stderr());
+       message = SvPVx(ERRSV, msglen);
+    {
+#ifdef USE_SFIO
+       /* SFIO can really mess with your errno */
+       int e = errno;
+#endif
+       PerlIO_write(PerlIO_stderr(), message, msglen);
+       (void)PerlIO_flush(PerlIO_stderr());
+#ifdef USE_SFIO
+       errno = e;
+#endif
+    }
     my_failure_exit();
     /* NOTREACHED */
     return 0;
@@ -1481,7 +1498,8 @@ PP(pp_caller)
        PUSHs(&PL_sv_undef);
     else
        PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0)));
-    PUSHs(sv_2mortal(newSVpv(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), 0)));
+    PUSHs(sv_2mortal(newSVpvn(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)),
+                             SvCUR(GvSV(cx->blk_oldcop->cop_filegv)))));
     PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
     if (!MAXARG)
        RETURN;
@@ -1492,7 +1510,7 @@ PP(pp_caller)
        PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
     }
     else {
-       PUSHs(sv_2mortal(newSVpv("(eval)",0)));
+       PUSHs(sv_2mortal(newSVpvn("(eval)",6)));
        PUSHs(sv_2mortal(newSViv(0)));
     }
     gimme = (I32)cx->blk_gimme;
@@ -2023,6 +2041,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) {
@@ -2111,6 +2130,7 @@ PP(pp_goto)
            /* Now do some callish stuff. */
            SAVETMPS;
            if (CvXSUB(cv)) {
+#ifdef PERL_XSUB_OLDSTYLE
                if (CvOLDSTYLE(cv)) {
                    I32 (*fp3)_((int,int,int));
                    while (SP > mark) {
@@ -2123,7 +2143,9 @@ PP(pp_goto)
                                   items);
                    SP = PL_stack_base + items;
                }
-               else {
+               else
+#endif /* PERL_XSUB_OLDSTYLE */
+               {
                    SV **newsp;
                    I32 gimme;
 
@@ -2276,12 +2298,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;
@@ -2607,7 +2632,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);
@@ -2622,7 +2647,7 @@ doeval(int gimme, OP** startop)
     PL_min_intro_pending = 0;
     PL_padix = 0;
 #ifdef USE_THREADS
-    av_store(PL_comppad_name, 0, newSVpv("@_", 2));
+    av_store(PL_comppad_name, 0, newSVpvn("@_", 2));
     PL_curpad[0] = (SV*)newAV();
     SvPADMY_on(PL_curpad[0]);  /* XXX Needed? */
 #endif /* USE_THREADS */
@@ -2656,7 +2681,7 @@ doeval(int gimme, OP** startop)
     PL_curcop = &PL_compiling;
     PL_curcop->cop_arybase = 0;
     SvREFCNT_dec(PL_rs);
-    PL_rs = newSVpv("\n", 1);
+    PL_rs = newSVpvn("\n", 1);
     if (saveop && saveop->op_flags & OPf_SPECIAL)
        PL_in_eval |= 4;
     else
@@ -2864,7 +2889,7 @@ PP(pp_require)
 
     ENTER;
     SAVETMPS;
-    lex_start(sv_2mortal(newSVpv("",0)));
+    lex_start(sv_2mortal(newSVpvn("",0)));
     SAVEGENERICSV(PL_rsfp_filters);
     PL_rsfp_filters = Nullav;