/* 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;
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;
/* prepare to compile file */
-#ifdef MACOS_TRADITIONAL
- if (PERL_FILE_IS_ABSOLUTE(name)
- || (*name == ':' && name[1] != ':' && strchr(name+2, ':')))
- {
- tryname = name;
- tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
- /* We consider paths of the form :a:b ambiguous and interpret them first
- as global then as local
- */
- if (!tryrsfp && *name == ':' && name[1] != ':' && strchr(name+2, ':'))
- goto trylocal;
- }
- else
-trylocal: {
-#else
- if (PERL_FILE_IS_ABSOLUTE(name)
- || (*name == '.' && (name[1] == '/' ||
- (name[1] == '.' && name[2] == '/'))))
- {
+ if (path_is_absolute(name)) {
tryname = name;
tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
}
- else {
-#endif
+ if (!tryrsfp) {
AV *ar = GvAVn(PL_incgv);
I32 i;
#ifdef VMS
}
}
else {
+ if (!path_is_absolute(name)
+#ifdef MACOS_TRADITIONAL
+ /* We consider paths of the form :a:b ambiguous and interpret them first
+ as global then as local
+ */
+ || (*name == ':' && name[1] != ':' && strchr(name+2, ':'))
+#endif
+ ) {
char *dir = SvPVx(dirsv, n_a);
#ifdef MACOS_TRADITIONAL
char buf[256];
tryname += 2;
break;
}
+ }
}
}
}
return len;
}
+/* perhaps someone can come up with a better name for
+ this? it is not really "absolute", per se ... */
+static bool
+S_path_is_absolute(pTHX_ char *name)
+{
+ if (PERL_FILE_IS_ABSOLUTE(name)
+#ifdef MACOS_TRADITIONAL
+ || (*name == ':' && name[1] != ':' && strchr(name+2, ':')))
+#else
+ || (*name == '.' && (name[1] == '/' ||
+ (name[1] == '.' && name[2] == '/'))))
+#endif
+ {
+ return TRUE;
+ }
+ else
+ return FALSE;
+}