INSTALL patches

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

diff --git a/pp_ctl.c b/pp_ctl.c
index 52fcf96..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.
@@ -1319,7 +1319,7 @@ dounwind(I32 cxix)
 }
 
 OP *
-die_where(char *message)
+die_where(char *message, STRLEN msglen)
 {
     dSP;
     STRLEN n_a;
@@ -1332,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) ";
@@ -1343,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);
                        }
                    }
@@ -1355,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);
@@ -1373,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);
@@ -1392,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;
@@ -1489,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;
@@ -1500,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;
@@ -2120,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) {
@@ -2132,7 +2143,9 @@ PP(pp_goto)
                                   items);
                    SP = PL_stack_base + items;
                }
-               else {
+               else
+#endif /* PERL_XSUB_OLDSTYLE */
+               {
                    SV **newsp;
                    I32 gimme;
 
@@ -2619,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);
@@ -2634,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 */
@@ -2668,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
@@ -2876,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;