X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=11b36134ff44dc4c27139438a0b61e30518987d2;hb=917211f59b1d5210f3944956e717bae1a2ca7565;hp=183849e12180c90104473167001728175a8c380f;hpb=eb1102fcca2230364ceadea29bd8e87ee51b15fa;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_ctl.c b/pp_ctl.c index 183849e..11b3613 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -158,6 +158,7 @@ PP(pp_substcont) register REGEXP *rx = cx->sb_rx; rxres_restore(&cx->sb_rxres, rx); + PL_reg_match_utf8 = SvUTF8(cx->sb_targ) ? 1 : 0; if (cx->sb_iters++) { I32 saviters = cx->sb_iters; @@ -395,7 +396,7 @@ PP(pp_formline) else { sv = &PL_sv_no; if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, "Not enough format arguments"); + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Not enough format arguments"); } break; @@ -895,13 +896,16 @@ PP(pp_flip) else { dTOPss; SV *targ = PAD_SV(PL_op->op_targ); - int flip; + int flip = 0; if (PL_op->op_private & OPpFLIP_LINENUM) { - struct io *gp_io; - flip = PL_last_in_gv - && (gp_io = GvIO(PL_last_in_gv)) - && SvIV(sv) == (IV)IoLINES(gp_io); + if (GvIO(PL_last_in_gv)) { + flip = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)); + } + else { + GV *gv = gv_fetchpv(".", TRUE, SVt_PV); + if (gv && GvSV(gv)) flip = SvIV(sv) == SvIV(GvSV(gv)); + } } else { flip = SvTRUE(sv); } @@ -979,11 +983,23 @@ PP(pp_flop) else { dTOPss; SV *targ = PAD_SV(cUNOP->op_first->op_targ); + int flop = 0; sv_inc(targ); - if ((PL_op->op_private & OPpFLIP_LINENUM) - ? (GvIO(PL_last_in_gv) - && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv))) - : SvTRUE(sv) ) { + + if (PL_op->op_private & OPpFLIP_LINENUM) { + if (GvIO(PL_last_in_gv)) { + flop = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)); + } + else { + GV *gv = gv_fetchpv(".", TRUE, SVt_PV); + if (gv && GvSV(gv)) flop = SvIV(sv) == SvIV(GvSV(gv)); + } + } + else { + flop = SvTRUE(sv); + } + + if (flop) { sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0); sv_catpv(targ, "E0"); } @@ -1006,27 +1022,27 @@ S_dopoptolabel(pTHX_ char *label) switch (CxTYPE(cx)) { case CXt_SUBST: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting substitution via %s", OP_NAME(PL_op)); break; case CXt_SUB: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting subroutine via %s", OP_NAME(PL_op)); break; case CXt_FORMAT: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting format via %s", OP_NAME(PL_op)); break; case CXt_EVAL: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting eval via %s", OP_NAME(PL_op)); break; case CXt_NULL: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting pseudo-block via %s", OP_NAME(PL_op)); return -1; case CXt_LOOP: @@ -1141,27 +1157,27 @@ S_dopoptoloop(pTHX_ I32 startingblock) switch (CxTYPE(cx)) { case CXt_SUBST: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting substitution via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting substitution via %s", OP_NAME(PL_op)); break; case CXt_SUB: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting subroutine via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting subroutine via %s", OP_NAME(PL_op)); break; case CXt_FORMAT: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting format via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting format via %s", OP_NAME(PL_op)); break; case CXt_EVAL: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting eval via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting eval via %s", OP_NAME(PL_op)); break; case CXt_NULL: if (ckWARN(WARN_EXITING)) - Perl_warner(aTHX_ WARN_EXITING, "Exiting pseudo-block via %s", + Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting pseudo-block via %s", OP_NAME(PL_op)); return -1; case CXt_LOOP: @@ -1224,6 +1240,9 @@ OP * Perl_die_where(pTHX_ char *message, STRLEN msglen) { STRLEN n_a; + IO *io; + MAGIC *mg; + if (PL_in_eval) { I32 cxix; register PERL_CONTEXT *cx; @@ -1249,7 +1268,7 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) sv_catpvn(err, message, msglen); if (ckWARN(WARN_MISC)) { STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1; - Perl_warner(aTHX_ WARN_MISC, SvPVX(err)+start); + Perl_warner(aTHX_ packWARN(WARN_MISC), SvPVX(err)+start); } } } @@ -1303,7 +1322,19 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) } if (!message) message = SvPVx(ERRSV, msglen); - { + + /* if STDERR is tied, print to it instead */ + if (PL_stderrgv && (io = GvIOp(PL_stderrgv)) + && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) { + dSP; ENTER; + PUSHMARK(SP); + XPUSHs(SvTIED_obj((SV*)io, mg)); + XPUSHs(sv_2mortal(newSVpvn(message, msglen))); + PUTBACK; + call_method("PRINT", G_SCALAR); + LEAVE; + } + else { #ifdef USE_SFIO /* SFIO can really mess with your errno */ int e = errno; @@ -1414,7 +1445,7 @@ PP(pp_caller) PUSHs(&PL_sv_undef); else PUSHs(sv_2mortal(newSVpv(stashname, 0))); - PUSHs(sv_2mortal(newSVpv(CopFILE(cx->blk_oldcop), 0))); + PUSHs(sv_2mortal(newSVpv(OutCopFILE(cx->blk_oldcop), 0))); PUSHs(sv_2mortal(newSViv((I32)CopLINE(cx->blk_oldcop)))); if (!MAXARG) RETURN; @@ -2855,7 +2886,7 @@ PP(pp_require) OP *op; sv = POPs; - if (SvNIOKp(sv)) { + if (SvNIOKp(sv) && PL_op->op_type != OP_DOFILE) { if (SvPOK(sv) && SvNOK(sv) && SvNV(sv)) { /* require v5.6.1 */ UV rev = 0, ver = 0, sver = 0; STRLEN len; @@ -2882,7 +2913,7 @@ PP(pp_require) PERL_VERSION, PERL_SUBVERSION); } if (ckWARN(WARN_PORTABLE)) - Perl_warner(aTHX_ WARN_PORTABLE, + Perl_warner(aTHX_ packWARN(WARN_PORTABLE), "v-string in use/require non-portable"); RETPUSHYES; }