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.
RETURN;
}
+
+/* also used for: pp_dbmclose() */
+
PP(pp_untie)
{
dSP;
}
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);
RETURN;
}
+
+/* also used for: pp_read() and pp_recv() (where supported) */
+
PP(pp_sysread)
{
dSP; dMARK; dORIGMARK; dTARGET;
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);
RETPUSHUNDEF;
}
+
+/* also used for: pp_send() where defined */
+
PP(pp_syswrite)
{
dSP; dMARK; dORIGMARK; dTARGET;
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;
}
}
RETURN;
}
+
+/* also used for: pp_seek() */
+
PP(pp_sysseek)
{
dSP;
}
}
+
+/* also used for: pp_fcntl() */
+
PP(pp_ioctl)
{
dSP; dTARGET;
#ifdef HAS_SOCKET
+/* also used for: pp_connect() */
+
PP(pp_bind)
{
dSP;
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;
}
+
+/* also used for: pp_gsockopt() */
+
PP(pp_ssockopt)
{
dSP;
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;
}
+
+/* also used for: pp_getsockname() */
+
PP(pp_getpeername)
{
dSP;
PUSHs(sv);
RETURN;
-nuts:
+ nuts:
report_evil_fh(gv);
SETERRNO(EBADF,SS_IVCHAN);
-nuts2:
+ nuts2:
RETPUSHUNDEF;
}
/* Stat calls. */
+/* also used for: pp_lstat() */
+
PP(pp_stat)
{
dSP;
}
+/* also used for: pp_fteexec() pp_fteread() pp_ftewrite() pp_ftrexec()
+ * pp_ftrwrite() */
+
PP(pp_ftrread)
{
I32 result;
FT_RETURNNO;
}
+
+/* also used for: pp_ftatime() pp_ftctime() pp_ftmtime() pp_ftsize() */
+
PP(pp_ftis)
{
I32 result;
}
}
+
+/* also used for: pp_ftblk() pp_ftchr() pp_ftdir() pp_fteowned()
+ * pp_ftfile() pp_ftpipe() pp_ftsgid() pp_ftsock()
+ * pp_ftsuid() pp_ftsvtx() pp_ftzero() */
+
PP(pp_ftrowned)
{
I32 result;
FT_RETURNNO;
}
+
+/* also used for: pp_ftbinary() */
+
PP(pp_fttext)
{
I32 i;
#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
}
+
+/* also used for: pp_chmod() pp_kill() pp_unlink() pp_utime() */
+
PP(pp_chown)
{
dSP; dMARK; dTARGET;
RETURN;
}
+
+/* also used for: pp_symlink() */
+
#if defined(HAS_LINK) || defined(HAS_SYMLINK)
PP(pp_link)
{
RETURN;
}
#else
+
+/* also used for: pp_symlink() */
+
PP(pp_link)
{
/* Have neither. */
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);
/* Sun Dec 29 12:00:00 2147483647 */
#define TIME_UPPER_BOUND 67767976233316800.0
+
+/* also used for: pp_localtime() */
+
PP(pp_gmtime)
{
dSP;
}
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 %.0f",
+ 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,
- /* XXX newSVpvf()'s %lld type is broken,
- * so cheat with a double */
- (double)tmbuf.tm_year + 1900));
+ (IV)tmbuf.tm_year + 1900);
}
}
else { /* list context */
/* Shared memory. */
/* Merged with some message passing. */
+/* also used for: pp_msgrcv() pp_msgsnd() pp_semop() pp_shmread() */
+
PP(pp_shmwrite)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
/* Semaphores. */
+/* also used for: pp_msgget() pp_shmget() */
+
PP(pp_semget)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
#endif
}
+/* also used for: pp_msgctl() pp_shmctl() */
+
PP(pp_semctl)
{
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
const int anum = do_ipcctl(PL_op->op_type, MARK, SP);
SP = MARK;
if (anum == -1)
- RETSETUNDEF;
+ RETPUSHUNDEF;
if (anum != 0) {
PUSHi(anum);
}
/* Get system info. */
+/* also used for: pp_ghbyaddr() pp_ghbyname() */
+
PP(pp_ghostent)
{
#if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT)
}
#endif
- if (GIMME != G_ARRAY) {
+ if (GIMME_V != G_ARRAY) {
PUSHs(sv = sv_newmortal());
if (hent) {
if (which == OP_GHBYNAME) {
#endif
}
+/* also used for: pp_gnbyaddr() pp_gnbyname() */
+
PP(pp_gnetent)
{
#if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)
#endif
EXTEND(SP, 4);
- if (GIMME != G_ARRAY) {
+ if (GIMME_V != G_ARRAY) {
PUSHs(sv = sv_newmortal());
if (nent) {
if (which == OP_GNBYNAME)
#endif
}
+
+/* also used for: pp_gpbyname() pp_gpbynumber() */
+
PP(pp_gprotoent)
{
#if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
#endif
EXTEND(SP, 3);
- if (GIMME != G_ARRAY) {
+ if (GIMME_V != G_ARRAY) {
PUSHs(sv = sv_newmortal());
if (pent) {
if (which == OP_GPBYNAME)
#endif
}
+
+/* also used for: pp_gsbyname() pp_gsbyport() */
+
PP(pp_gservent)
{
#if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)
#endif
EXTEND(SP, 4);
- if (GIMME != G_ARRAY) {
+ if (GIMME_V != G_ARRAY) {
PUSHs(sv = sv_newmortal());
if (sent) {
if (which == OP_GSBYNAME) {
#endif
}
+
+/* also used for: pp_snetent() pp_sprotoent() pp_sservent() */
+
PP(pp_shostent)
{
dSP;
RETSETYES;
}
+
+/* also used for: pp_egrent() pp_enetent() pp_eprotoent() pp_epwent()
+ * pp_eservent() pp_sgrent() pp_spwent() */
+
PP(pp_ehostent)
{
dSP;
RETPUSHYES;
}
+
+/* also used for: pp_gpwnam() pp_gpwuid() */
+
PP(pp_gpwent)
{
#ifdef HAS_PASSWD
}
EXTEND(SP, 10);
- if (GIMME != G_ARRAY) {
+ if (GIMME_V != G_ARRAY) {
PUSHs(sv = sv_newmortal());
if (pwent) {
if (which == OP_GPWNAM)
#endif
}
+
+/* also used for: pp_ggrgid() pp_ggrnam() */
+
PP(pp_ggrent)
{
#ifdef HAS_GROUP
#endif
EXTEND(SP, 4);
- if (GIMME != G_ARRAY) {
+ if (GIMME_V != G_ARRAY) {
SV * const sv = sv_newmortal();
PUSHs(sv);
https://perl5.git.perl.org / perl5.git / blobdiff