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;
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;
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);
}
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");
}
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:
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:
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;
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);
}
}
}
}
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;
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;
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;
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;
}