In Perl_pad_check_dup(), use sv rather than name for diagnostics.

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

diff --git a/pp_ctl.c b/pp_ctl.c
index c62ce26..06a0f73 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -93,36 +93,63 @@ PP(pp_regcomp)
        RETURN;
     }
 #endif
+
+#define tryAMAGICregexp(rx)                    \
+    STMT_START {                               \
+       if (SvROK(rx) && SvAMAGIC(rx)) {        \
+           SV *sv = AMG_CALLun(rx, regexp);    \
+           if (sv) {                           \
+               if (SvROK(sv))                  \
+                   sv = SvRV(sv);              \
+               if (SvTYPE(sv) != SVt_REGEXP)   \
+                   Perl_croak(aTHX_ "Overloaded qr did not return a REGEXP"); \
+               rx = sv;                        \
+           }                                   \
+       }                                       \
+    } STMT_END
+           
+
     if (PL_op->op_flags & OPf_STACKED) {
        /* multiple args; concatentate them */
        dMARK; dORIGMARK;
        tmpstr = PAD_SV(ARGTARG);
        sv_setpvs(tmpstr, "");
        while (++MARK <= SP) {
+           SV *msv = *MARK;
            if (PL_amagic_generation) {
                SV *sv;
-               if ((SvAMAGIC(tmpstr) || SvAMAGIC(*MARK)) &&
-                   (sv = amagic_call(tmpstr, *MARK, concat_amg, AMGf_assign)))
+
+               tryAMAGICregexp(msv);
+
+               if ((SvAMAGIC(tmpstr) || SvAMAGIC(msv)) &&
+                   (sv = amagic_call(tmpstr, msv, concat_amg, AMGf_assign)))
                {
                   sv_setsv(tmpstr, sv);
                   continue;
                }
            }
-           sv_catsv(tmpstr, *MARK);
+           sv_catsv(tmpstr, msv);
        }
        SvSETMAGIC(tmpstr);
        SP = ORIGMARK;
     }
-    else
+    else {
        tmpstr = POPs;
+       tryAMAGICregexp(tmpstr);
+    }
+
+#undef tryAMAGICregexp
 
     if (SvROK(tmpstr)) {
        SV * const sv = SvRV(tmpstr);
        if (SvTYPE(sv) == SVt_REGEXP)
            re = (REGEXP*) sv;
     }
+    else if (SvTYPE(tmpstr) == SVt_REGEXP)
+       re = (REGEXP*) tmpstr;
+
     if (re) {
-       re = reg_temp_copy(re);
+       re = reg_temp_copy(NULL, re);
        ReREFCNT_dec(PM_GETRE(pm));
        PM_SETRE(pm, re);
     }
@@ -1516,8 +1543,8 @@ Perl_qerror(pTHX_ SV *err)
        ++PL_parser->error_count;
 }
 
-OP *
-Perl_die_where(pTHX_ const char *message, STRLEN msglen)
+void
+Perl_die_where(pTHX_ SV *msv)
 {
     dVAR;
 
@@ -1525,15 +1552,17 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
        I32 cxix;
        I32 gimme;
 
-       if (message) {
+       if (msv) {
            if (PL_in_eval & EVAL_KEEPERR) {
                 static const char prefix[] = "\t(in cleanup) ";
                SV * const err = ERRSV;
                const char *e = NULL;
                if (!SvPOK(err))
                    sv_setpvs(err,"");
-               else if (SvCUR(err) >= sizeof(prefix)+msglen-1) {
+               else if (SvCUR(err) >= sizeof(prefix)+SvCUR(msv)-1) {
                    STRLEN len;
+                   STRLEN msglen;
+                   const char* message = SvPV_const(msv, msglen);
                    e = SvPV_const(err, len);
                    e += len - msglen;
                    if (*e != *message || strNE(e,message))
@@ -1541,16 +1570,19 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
                }
                if (!e) {
                    STRLEN start;
-                   SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen);
+                   SvGROW(err, SvCUR(err)+sizeof(prefix)+SvCUR(msv));
                    sv_catpvn(err, prefix, sizeof(prefix)-1);
-                   sv_catpvn(err, message, msglen);
-                   start = SvCUR(err)-msglen-sizeof(prefix)+1;
+                   sv_catsv(err, msv);
+                   start = SvCUR(err)-SvCUR(msv)-sizeof(prefix)+1;
                    Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "%s",
                                   SvPVX_const(err)+start);
                }
            }
            else {
+               STRLEN msglen;
+               const char* message = SvPV_const(msv, msglen);
                sv_setpvn(ERRSV, message, msglen);
+               SvFLAGS(ERRSV) |= SvFLAGS(msv) & SVf_UTF8;
            }
        }
 
@@ -1571,8 +1603,8 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
 
            POPBLOCK(cx,PL_curpm);
            if (CxTYPE(cx) != CXt_EVAL) {
-               if (!message)
-                   message = SvPVx_const(ERRSV, msglen);
+               STRLEN msglen;
+               const char* message = SvPVx_const( msv ? msv : ERRSV, msglen);
                PerlIO_write(Perl_error_log, (const char *)"panic: die ", 11);
                PerlIO_write(Perl_error_log, message, msglen);
                my_exit(1);
@@ -1600,16 +1632,15 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
                    *msg ? msg : "Unknown error\n");
            }
            assert(CxTYPE(cx) == CXt_EVAL);
-           return cx->blk_eval.retop;
+           PL_restartop = cx->blk_eval.retop;
+           JMPENV_JUMP(3);
+           /* NOTREACHED */
        }
     }
-    if (!message)
-       message = SvPVx_const(ERRSV, msglen);
 
-    write_to_stderr(message, msglen);
+    write_to_stderr( msv ? msv : ERRSV );
     my_failure_exit();
     /* NOTREACHED */
-    return 0;
 }
 
 PP(pp_xor)
@@ -3573,11 +3604,14 @@ PP(pp_require)
         PL_compiling.cop_warnings = pWARN_STD ;
 
     if (filter_sub || filter_cache) {
-       SV * const datasv = filter_add(S_run_user_filter, NULL);
+       /* We can use the SvPV of the filter PVIO itself as our cache, rather
+          than hanging another SV from it. In turn, filter_add() optionally
+          takes the SV to use as the filter (or creates a new SV if passed
+          NULL), so simply pass in whatever value filter_cache has.  */
+       SV * const datasv = filter_add(S_run_user_filter, filter_cache);
        IoLINES(datasv) = filter_has_file;
        IoTOP_GV(datasv) = MUTABLE_GV(filter_state);
        IoBOTTOM_GV(datasv) = MUTABLE_GV(filter_sub);
-       IoFMT_GV(datasv) = MUTABLE_GV(filter_cache);
     }
 
     /* switch to eval mode */
@@ -4830,8 +4864,8 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
        for PL_parser->error_count == 0.)  Solaris doesn't segfault --
        not sure where the trouble is yet.  XXX */
 
-    if (IoFMT_GV(datasv)) {
-       SV *const cache = MUTABLE_SV(IoFMT_GV(datasv));
+    {
+       SV *const cache = datasv;
        if (SvOK(cache)) {
            STRLEN cache_len;
            const char *cache_p = SvPV(cache, cache_len);
@@ -4930,11 +4964,9 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     if (prune_from) {
        /* Oh. Too long. Stuff some in our cache.  */
        STRLEN cached_len = got_p + got_len - prune_from;
-       SV *cache = MUTABLE_SV(IoFMT_GV(datasv));
+       SV *const cache = datasv;
 
-       if (!cache) {
-           IoFMT_GV(datasv) = MUTABLE_GV((cache = newSV(got_len - umaxlen)));
-       } else if (SvOK(cache)) {
+       if (SvOK(cache)) {
            /* Cache should be empty.  */
            assert(!SvCUR(cache));
        }
@@ -4963,7 +4995,6 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 
     if (status <= 0) {
        IoLINES(datasv) = 0;
-       SvREFCNT_dec(IoFMT_GV(datasv));
        if (filter_state) {
            SvREFCNT_dec(filter_state);
            IoTOP_GV(datasv) = NULL;