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("``");
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))));
- 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));
- }
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;
}
forget_top:
- cx = &cxstack[cxstack_ix];
+ cx = CX_CUR();
assert(CxTYPE(cx) == CXt_FORMAT);
SP = PL_stack_base + cx->blk_oldsp; /* ignore retval of formline */
CX_LEAVE_SCOPE(cx);
- POPFORMAT(cx);
- POPBLOCK(cx);
+ cx_popformat(cx);
+ cx_popblock(cx);
retop = cx->blk_sub.retop;
- cxstack_ix--;
+ CX_POP(cx);
if (is_return)
/* XXX the semantics of doing 'return' in a format aren't documented.
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);