PERL_ARGS_ASSERT_TIED_METHOD;
/* Ensure that our flag bits do not overlap. */
- assert((TIED_METHOD_MORTALIZE_NOT_NEEDED & G_WANT) == 0);
- assert((TIED_METHOD_ARGUMENTS_ON_STACK & G_WANT) == 0);
- assert((TIED_METHOD_SAY & G_WANT) == 0);
+ STATIC_ASSERT_STMT((TIED_METHOD_MORTALIZE_NOT_NEEDED & G_WANT) == 0);
+ STATIC_ASSERT_STMT((TIED_METHOD_ARGUMENTS_ON_STACK & G_WANT) == 0);
+ STATIC_ASSERT_STMT((TIED_METHOD_SAY & G_WANT) == 0);
PUTBACK; /* sp is at *foot* of args, so this pops args from old stack */
PUSHSTACKi(PERLSI_MAGIC);
#endif
RETPUSHYES;
-badexit:
+ badexit:
RETPUSHUNDEF;
#else
DIE(aTHX_ PL_no_func, "pipe");
return tied_method0(SV_CONST(FILENO), SP, MUTABLE_SV(io), mg);
}
+ if (io && IoDIRP(io)) {
+#if defined(HAS_DIRFD) || defined(HAS_DIR_DD_FD)
+ PUSHi(my_dirfd(IoDIRP(io)));
+ RETURN;
+#elif defined(ENOTSUP)
+ errno = ENOTSUP; /* Operation not supported */
+ RETPUSHUNDEF;
+#elif defined(EOPNOTSUPP)
+ errno = EOPNOTSUPP; /* Operation not supported on socket */
+ RETPUSHUNDEF;
+#else
+ errno = EINVAL; /* Invalid argument */
+ RETPUSHUNDEF;
+#endif
+ }
+
if (!io || !(fp = IoIFP(io))) {
/* Can't do this because people seem to do things like
defined(fileno($foo)) to check whether $foo is a valid fh.
}
PUSHi(nfound);
- if (GIMME == G_ARRAY && tbuf) {
+ if (GIMME_V == G_ARRAY && tbuf) {
value = (NV)(timebuf.tv_sec) +
(NV)(timebuf.tv_usec) / 1000000.0;
mPUSHn(value);
bytes from a byte file handle into a UTF8 buffer, but it won't harm us
unduly.
(should be 2 * length + offset + 1, or possibly something longer if
- PL_encoding is true) */
+ IN_ENCODING Is true) */
buffer = SvGROW(bufsv, (STRLEN)(length+offset+1));
if (offset > 0 && offset > (SSize_t)orig_size) { /* Zero any newly allocated space */
Zero(buffer+orig_size, offset-orig_size, char);
if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) { /* eof() */
if (io && !IoIFP(io)) {
if ((IoFLAGS(io) & IOf_START) && av_tindex(GvAVn(gv)) < 0) {
+ SV ** svp;
IoLINES(io) = 0;
IoFLAGS(io) &= ~IOf_START;
do_open6(gv, "-", 1, NULL, NULL, 0);
- if (GvSV(gv))
- sv_setpvs(GvSV(gv), "-");
+ svp = &GvSV(gv);
+ if (*svp) {
+ SV * sv = *svp;
+ sv_setpvs(sv, "-");
+ SvSETMAGIC(sv);
+ }
else
- GvSV(gv) = newSVpvs("-");
- SvSETMAGIC(GvSV(gv));
+ *svp = newSVpvs("-");
}
- else if (!nextargv(gv))
+ else if (!nextargv(gv, FALSE))
RETPUSHYES;
}
}
else
RETPUSHUNDEF;
-nuts:
+ nuts:
report_evil_fh(gv);
SETERRNO(EBADF,SS_IVCHAN);
RETPUSHUNDEF;
else
RETPUSHUNDEF;
-nuts:
+ nuts:
report_evil_fh(gv);
SETERRNO(EBADF,SS_IVCHAN);
RETPUSHUNDEF;
PUSHp(namebuf, len);
RETURN;
-nuts:
+ nuts:
report_evil_fh(ggv);
SETERRNO(EBADF,SS_IVCHAN);
-badexit:
+ badexit:
RETPUSHUNDEF;
}
PUSHi( PerlSock_shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 );
RETURN;
-nuts:
+ nuts:
report_evil_fh(gv);
SETERRNO(EBADF,SS_IVCHAN);
RETPUSHUNDEF;
len = SvCUR(sv);
if (PerlSock_getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0)
goto nuts2;
+#if defined(_AIX)
+ /* XXX Configure test: does getsockopt set the length properly? */
+ if (len == 256)
+ len = sizeof(int);
+#endif
SvCUR_set(sv, len);
*SvEND(sv) ='\0';
PUSHs(sv);
}
RETURN;
-nuts:
+ nuts:
report_evil_fh(gv);
SETERRNO(EBADF,SS_IVCHAN);
-nuts2:
+ nuts2:
RETPUSHUNDEF;
}
PUSHs(sv);
RETURN;
-nuts:
+ nuts:
report_evil_fh(gv);
SETERRNO(EBADF,SS_IVCHAN);
-nuts2:
+ nuts2:
RETPUSHUNDEF;
}
#endif
assert(len);
- if (! is_ascii_string((U8 *) s, len)) {
+ if (! is_invariant_string((U8 *) s, len)) {
const U8 *ep;
- /* Here contains a non-ASCII. 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 */
+ /* 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))
{
#endif
RETURN;
+#ifdef HAS_FCHDIR
nuts:
report_evil_fh(gv);
SETERRNO(EBADF,RMS_IFI);
PUSHi(0);
RETURN;
+#endif
}
goto nope;
RETPUSHYES;
-nope:
+ nope:
if (!errno)
SETERRNO(EBADF,RMS_DIR);
RETPUSHUNDEF;
dSP;
SV *sv;
- const I32 gimme = GIMME;
+ const I32 gimme = GIMME_V;
GV * const gv = MUTABLE_GV(POPs);
const Direntry_t *dp;
IO * const io = GvIOn(gv);
RETURN;
-nope:
+ nope:
if (!errno)
SETERRNO(EBADF,RMS_ISI);
- if (GIMME == G_ARRAY)
+ if (gimme == G_ARRAY)
RETURN;
else
RETPUSHUNDEF;
PUSHi( PerlDir_tell(IoDIRP(io)) );
RETURN;
-nope:
+ nope:
if (!errno)
SETERRNO(EBADF,RMS_ISI);
RETPUSHUNDEF;
(void)PerlDir_seek(IoDIRP(io), along);
RETPUSHYES;
-nope:
+ nope:
if (!errno)
SETERRNO(EBADF,RMS_ISI);
RETPUSHUNDEF;
}
(void)PerlDir_rewind(IoDIRP(io));
RETPUSHYES;
-nope:
+ nope:
if (!errno)
SETERRNO(EBADF,RMS_ISI);
RETPUSHUNDEF;
IoDIRP(io) = 0;
RETPUSHYES;
-nope:
+ nope:
if (!errno)
SETERRNO(EBADF,RMS_IFI);
RETPUSHUNDEF;
Pid_t pgrp;
Pid_t pid;
pgrp = MAXARG == 2 && (TOPs||POPs) ? POPi : 0;
- if (MAXARG > 0) pid = TOPs && TOPi;
+ if (MAXARG > 0) pid = TOPs ? TOPi : 0;
else {
pid = 0;
- XPUSHi(-1);
+ EXTEND(SP,1);
+ SP++;
}
TAINT_PROPER("setpgrp");
(void)PerlProc_times(×buf);
mPUSHn(((NV)timesbuf.tms_utime)/(NV)PL_clocktick);
- if (GIMME == G_ARRAY) {
+ if (GIMME_V == G_ARRAY) {
mPUSHn(((NV)timesbuf.tms_stime)/(NV)PL_clocktick);
mPUSHn(((NV)timesbuf.tms_cutime)/(NV)PL_clocktick);
mPUSHn(((NV)timesbuf.tms_cstime)/(NV)PL_clocktick);
dSP;
mPUSHn(0.0);
EXTEND(SP, 4);
- if (GIMME == G_ARRAY) {
+ if (GIMME_V == G_ARRAY) {
mPUSHn(0.0);
mPUSHn(0.0);
mPUSHn(0.0);
}
else {
NV input = Perl_floor(POPn);
+ const bool pl_isnan = Perl_isnan(input);
when = (Time64_T)input;
- if (when != input) {
+ if (UNLIKELY(pl_isnan || when != input)) {
/* diag_listed_as: gmtime(%f) too large */
Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
"%s(%.0" NVff ") too large", opname, input);
+ if (pl_isnan) {
+ err = NULL;
+ goto failed;
+ }
}
}
if (err == NULL) {
/* diag_listed_as: gmtime(%f) failed */
/* XXX %lld broken for quads */
+ failed:
Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
"%s(%.0" NVff ") failed", opname, when);
}
- if (GIMME != G_ARRAY) { /* scalar context */
+ if (GIMME_V != G_ARRAY) { /* scalar context */
EXTEND(SP, 1);
- EXTEND_MORTAL(1);
if (err == NULL)
RETPUSHUNDEF;
else {
- mPUSHs(Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %"IVdf,
+ dTARGET;
+ PUSHs(TARG);
+ Perl_sv_setpvf_mg(aTHX_ TARG, "%s %s %2d %02d:%02d:%02d %"IVdf,
dayname[tmbuf.tm_wday],
monname[tmbuf.tm_mon],
tmbuf.tm_mday,
tmbuf.tm_hour,
tmbuf.tm_min,
tmbuf.tm_sec,
- (IV)tmbuf.tm_year + 1900));
+ (IV)tmbuf.tm_year + 1900);
}
}
else { /* list context */
const int anum = do_ipcctl(PL_op->op_type, MARK, SP);
SP = MARK;
if (anum == -1)
- RETSETUNDEF;
+ RETPUSHUNDEF;
if (anum != 0) {
PUSHi(anum);
}
}
#endif
- if (GIMME != G_ARRAY) {
+ if (GIMME_V != G_ARRAY) {
PUSHs(sv = sv_newmortal());
if (hent) {
if (which == OP_GHBYNAME) {
#endif
EXTEND(SP, 4);
- if (GIMME != G_ARRAY) {
+ if (GIMME_V != G_ARRAY) {
PUSHs(sv = sv_newmortal());
if (nent) {
if (which == OP_GNBYNAME)
#endif
EXTEND(SP, 3);
- if (GIMME != G_ARRAY) {
+ if (GIMME_V != G_ARRAY) {
PUSHs(sv = sv_newmortal());
if (pent) {
if (which == OP_GPBYNAME)
#endif
EXTEND(SP, 4);
- if (GIMME != G_ARRAY) {
+ if (GIMME_V != G_ARRAY) {
PUSHs(sv = sv_newmortal());
if (sent) {
if (which == OP_GSBYNAME) {
}
EXTEND(SP, 10);
- if (GIMME != G_ARRAY) {
+ if (GIMME_V != G_ARRAY) {
PUSHs(sv = sv_newmortal());
if (pwent) {
if (which == OP_GPWNAM)
#endif
EXTEND(SP, 4);
- if (GIMME != G_ARRAY) {
+ if (GIMME_V != G_ARRAY) {
SV * const sv = sv_newmortal();
PUSHs(sv);