dSP; dTARGET;
PerlIO *fp;
const char * const tmps = POPpconstx;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
const char *mode = "r";
TAINT_PROPER("``");
PUTBACK; /* sp is at *foot* of args, so this pops args from old stack */
PUSHSTACKi(PERLSI_MAGIC);
/* extend for object + args. If argc might wrap/truncate when cast
- * to SSize_t, set to -1 which will trigger a panic in EXTEND() */
+ * to SSize_t and incremented, set to -1, which will trigger a panic in
+ * EXTEND().
+ * The weird way this is written is because g++ is dumb enough to
+ * warn "comparison is always false" on something like:
+ *
+ * sizeof(a) >= sizeof(b) && a >= B_t_MAX -1
+ *
+ * (where the LH condition is false)
+ */
extend_size =
- sizeof(argc) >= sizeof(SSize_t) && argc > SSize_t_MAX - 1
+ (argc > (sizeof(argc) >= sizeof(SSize_t) ? SSize_t_MAX - 1 : argc))
? -1 : (SSize_t)argc + 1;
EXTEND(SP, extend_size);
PUSHMARK(sp);
GV * const wgv = MUTABLE_GV(POPs);
GV * const rgv = MUTABLE_GV(POPs);
- assert (isGV_with_GP(rgv));
- assert (isGV_with_GP(wgv));
rstio = GvIOn(rgv);
if (IoIFP(rstio))
do_close(rgv, FALSE);
void
Perl_setdefout(pTHX_ GV *gv)
{
+ GV *oldgv = PL_defoutgv;
+
PERL_ARGS_ASSERT_SETDEFOUT;
+
SvREFCNT_inc_simple_void_NN(gv);
- SvREFCNT_dec(PL_defoutgv);
PL_defoutgv = gv;
+ SvREFCNT_dec(oldgv);
}
PP(pp_select)
if (io) {
const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
if (mg) {
- const U32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
Perl_tied_method(aTHX_ SV_CONST(GETC), SP, MUTABLE_SV(io), mg, gimme, 0);
if (gimme == G_SCALAR) {
SPAGAIN;
S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
{
PERL_CONTEXT *cx;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
PERL_ARGS_ASSERT_DOFORM;
if (CvCLONE(cv))
cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
- ENTER;
- SAVETMPS;
-
- PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
- PUSHFORMAT(cx, retop);
- if (CvDEPTH(cv) >= 2) {
- PERL_STACK_OVERFLOW_CHECK();
+ cx = cx_pushblock(CXt_FORMAT, gimme, PL_stack_sp, PL_savestack_ix);
+ cx_pushformat(cx, cv, retop, gv);
+ if (CvDEPTH(cv) >= 2)
pad_push(CvPADLIST(cv), CvDEPTH(cv));
- }
- SAVECOMPPAD();
PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv));
setdefout(gv); /* locally select filehandle so $% et al work */
PP(pp_leavewrite)
{
dSP;
- GV * const gv = cxstack[cxstack_ix].blk_format.gv;
+ GV * const gv = CX_CUR()->blk_format.gv;
IO * const io = GvIOp(gv);
PerlIO *ofp;
PerlIO *fp;
- SV **newsp;
- I32 gimme;
PERL_CONTEXT *cx;
OP *retop;
bool is_return = cBOOL(PL_op->op_type == OP_RETURN);
}
forget_top:
- POPBLOCK(cx,PL_curpm);
+ cx = CX_CUR();
+ assert(CxTYPE(cx) == CXt_FORMAT);
+ SP = PL_stack_base + cx->blk_oldsp; /* ignore retval of formline */
+ CX_LEAVE_SCOPE(cx);
+ cx_popformat(cx);
+ cx_popblock(cx);
retop = cx->blk_sub.retop;
- POPFORMAT(cx);
- SP = newsp; /* ignore retval of formline */
- LEAVE;
+ CX_POP(cx);
if (is_return)
/* XXX the semantics of doing 'return' in a format aren't documented.
}
}
PL_formtarget = PL_bodytarget;
- PERL_UNUSED_VAR(gimme);
RETURNOP(retop);
}
TAINT_PROPER("socket");
fd = PerlSock_socket(domain, type, protocol);
if (fd < 0) {
- SETERRNO(EBADF,RMS_IFI);
RETPUSHUNDEF;
}
IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE); /* stdio gets confused about sockets */
dSP;
GV *gv = NULL;
IO *io = NULL;
- I32 gimme;
+ U8 gimme;
I32 max = 13;
SV* sv;
}
PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
if (PL_laststatval < 0) {
+ dSAVE_ERRNO;
(void)PerlIO_close(fp);
- SETERRNO(EBADF,RMS_IFI);
+ RESTORE_ERRNO;
FT_RETURNUNDEF;
}
PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL);
#endif
assert(len);
- if (! is_invariant_string((U8 *) s, len)) {
- const U8 *ep;
+ if (! is_utf8_invariant_string((U8 *) s, len)) {
/* Here contains a variant under UTF-8 . See if the entire string is
- * UTF-8. But the buffer may end in a partial character, so consider
- * it UTF-8 if the first non-UTF8 char is an ending partial */
- if (is_utf8_string_loc((U8 *) s, len, &ep)
- || ep + UTF8SKIP(ep) > (U8 *) (s + len))
- {
+ * UTF-8. */
+ if (is_utf8_fixed_width_buf_flags((U8 *) s, len, 0)) {
if (PL_op->op_type == OP_FTTEXT) {
FT_RETURNYES;
}
dSP;
SV *sv;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
GV * const gv = MUTABLE_GV(POPs);
const Direntry_t *dp;
IO * const io = GvIOn(gv);
{
SV *target;
- PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL;
-
- if (*array) {
+ if (array && *array) {
target = newSVpvs_flags("", SVs_TEMP);
while (1) {
sv_catpv(target, *array);