/* pp_ctl.c
*
- * Copyright (c) 1991-2001, Larry Wall
+ * Copyright (c) 1991-2002, 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.
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 {
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");
}
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;
}
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;
/* perhaps someone can come up with a better name for
this? it is not really "absolute", per se ... */
-bool
-path_is_absolute(char *name)
+static bool
+S_path_is_absolute(pTHX_ char *name)
{
if (PERL_FILE_IS_ABSOLUTE(name)
#ifdef MACOS_TRADITIONAL