GV * const gv = MUTABLE_GV(*++MARK);
- if (!isGV(gv))
+ if (!isGV(gv) && !(SvTYPE(gv) == SVt_PVLV && isGV_with_GP(gv)))
DIE(aTHX_ PL_no_usym, "filehandle");
if ((io = GvIOp(gv))) {
methname = "TIEARRAY";
break;
case SVt_PVGV:
- if (isGV_with_GP(varsv)) {
+ case SVt_PVLV:
+ if (isGV_with_GP(varsv) && !SvFAKE(varsv)) {
methname = "TIEHANDLE";
how = PERL_MAGIC_tiedscalar;
/* For tied filehandles, we apply tiedscalar magic to the IO
const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
- if (isGV_with_GP(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
+ if (isGV_with_GP(sv) && !SvFAKE(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
RETPUSHUNDEF;
if ((mg = SvTIED_mg(sv, how))) {
PERL_ARGS_ASSERT_DOFORM;
+ if (cv && CvCLONE(cv))
+ cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
+
ENTER;
SAVETMPS;
not_a_format_reference:
DIE(aTHX_ "Not a format reference");
}
- if (CvCLONE(cv))
- cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
-
IoFLAGS(io) &= ~IOf_DIDTOP;
return doform(cv,gv,PL_op->op_next);
}
SV **newsp;
I32 gimme;
register PERL_CONTEXT *cx;
+ OP *retop;
if (!io || !(ofp = IoOFP(io)))
goto forget_top;
else
DIE(aTHX_ "Undefined top format called");
}
- if (cv && CvCLONE(cv))
- cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
return doform(cv, gv, PL_op);
}
forget_top:
POPBLOCK(cx,PL_curpm);
POPFORMAT(cx);
+ retop = cx->blk_sub.retop;
LEAVE;
fp = IoOFP(io);
PUTBACK;
PERL_UNUSED_VAR(newsp);
PERL_UNUSED_VAR(gimme);
- return cx->blk_sub.retop;
+ return retop;
}
PP(pp_prtf)
(struct sockaddr *)namebuf, &bufsize);
if (count < 0)
RETPUSHUNDEF;
+ /* MSG_TRUNC can give oversized count; quietly lose it */
+ if (count > length)
+ count = length;
#ifdef EPOC
/* Bogus return without padding */
bufsize = sizeof (struct sockaddr_in);
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
- else if (isGV(TOPs))
+ else if (isGV_with_GP(TOPs))
gv = MUTABLE_GV(POPs);
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = MUTABLE_GV(SvRV(POPs));
if (PL_op->op_flags & OPf_REF)
gv = cGVOP_gv;
- else if (isGV(TOPs))
+ else if (isGV_with_GP(TOPs))
gv = MUTABLE_GV(POPs);
else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
gv = MUTABLE_GV(SvRV(POPs));
#endif
}
+#ifdef __GLIBC__
+# define PRIORITY_WHICH_T(which) (__priority_which_t)which
+#else
+# define PRIORITY_WHICH_T(which) which
+#endif
+
PP(pp_getpriority)
{
#ifdef HAS_GETPRIORITY
dVAR; dSP; dTARGET;
const int who = POPi;
const int which = TOPi;
- SETi( getpriority(which, who) );
+ SETi( getpriority(PRIORITY_WHICH_T(which), who) );
RETURN;
#else
DIE(aTHX_ PL_no_func, "getpriority()");
const int who = POPi;
const int which = TOPi;
TAINT_PROPER("setpriority");
- SETi( setpriority(which, who, niceval) >= 0 );
+ SETi( setpriority(PRIORITY_WHICH_T(which), who, niceval) >= 0 );
RETURN;
#else
DIE(aTHX_ PL_no_func, "setpriority()");
#endif
}
+#undef PRIORITY_WHICH_T
+
/* Time calls. */
PP(pp_time)
EXTEND(SP, 1);
if (!(tmps = PerlProc_getlogin()))
RETPUSHUNDEF;
- PUSHp(tmps, strlen(tmps));
+ sv_setpv_mg(TARG, tmps);
+ PUSHs(TARG);
RETURN;
#else
DIE(aTHX_ PL_no_func, "getlogin");