X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/6d59e610a3f269be73ffea56a90d1cd7dc8bf2fd..128e4113466e835078eb016709e5d23b86be3120:/pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 8f6c753..e2f8edf 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -717,7 +717,7 @@ PP(pp_pipe_op)
 #endif
     RETPUSHYES;
 
-badexit:
+  badexit:
     RETPUSHUNDEF;
 #else
     DIE(aTHX_ PL_no_func, "pipe");
@@ -743,6 +743,22 @@ PP(pp_fileno)
 	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.
@@ -1231,7 +1247,7 @@ PP(pp_sselect)
     }
 
     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);
@@ -2115,14 +2131,18 @@ PP(pp_eof)
     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, FALSE))
 		RETPUSHYES;
@@ -2535,7 +2555,7 @@ PP(pp_bind)
     else
 	RETPUSHUNDEF;
 
-nuts:
+  nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
@@ -2556,7 +2576,7 @@ PP(pp_listen)
     else
 	RETPUSHUNDEF;
 
-nuts:
+  nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
@@ -2618,11 +2638,11 @@ PP(pp_accept)
     PUSHp(namebuf, len);
     RETURN;
 
-nuts:
+  nuts:
     report_evil_fh(ggv);
     SETERRNO(EBADF,SS_IVCHAN);
 
-badexit:
+  badexit:
     RETPUSHUNDEF;
 
 }
@@ -2640,7 +2660,7 @@ PP(pp_shutdown)
     PUSHi( PerlSock_shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 );
     RETURN;
 
-nuts:
+  nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
@@ -2720,10 +2740,10 @@ PP(pp_ssockopt)
     }
     RETURN;
 
-nuts:
+  nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
-nuts2:
+  nuts2:
     RETPUSHUNDEF;
 
 }
@@ -2784,10 +2804,10 @@ PP(pp_getpeername)
     PUSHs(sv);
     RETURN;
 
-nuts:
+  nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
-nuts2:
+  nuts2:
     RETPUSHUNDEF;
 }
 
@@ -3613,11 +3633,13 @@ PP(pp_chdir)
 #endif
     RETURN;
 
+#ifdef HAS_FCHDIR
  nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,RMS_IFI);
     PUSHi(0);
     RETURN;
+#endif
 }
 
 
@@ -3923,7 +3945,7 @@ PP(pp_open_dir)
 	goto nope;
 
     RETPUSHYES;
-nope:
+  nope:
     if (!errno)
 	SETERRNO(EBADF,RMS_DIR);
     RETPUSHUNDEF;
@@ -3943,7 +3965,7 @@ PP(pp_readdir)
     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);
@@ -3974,10 +3996,10 @@ PP(pp_readdir)
 
     RETURN;
 
-nope:
+  nope:
     if (!errno)
 	SETERRNO(EBADF,RMS_ISI);
-    if (GIMME == G_ARRAY)
+    if (gimme == G_ARRAY)
 	RETURN;
     else
 	RETPUSHUNDEF;
@@ -4007,7 +4029,7 @@ PP(pp_telldir)
 
     PUSHi( PerlDir_tell(IoDIRP(io)) );
     RETURN;
-nope:
+  nope:
     if (!errno)
 	SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
@@ -4033,7 +4055,7 @@ PP(pp_seekdir)
     (void)PerlDir_seek(IoDIRP(io), along);
 
     RETPUSHYES;
-nope:
+  nope:
     if (!errno)
 	SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
@@ -4057,7 +4079,7 @@ PP(pp_rewinddir)
     }
     (void)PerlDir_rewind(IoDIRP(io));
     RETPUSHYES;
-nope:
+  nope:
     if (!errno)
 	SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
@@ -4090,7 +4112,7 @@ PP(pp_closedir)
     IoDIRP(io) = 0;
 
     RETPUSHYES;
-nope:
+  nope:
     if (!errno)
 	SETERRNO(EBADF,RMS_IFI);
     RETPUSHUNDEF;
@@ -4532,7 +4554,7 @@ PP(pp_tms)
     (void)PerlProc_times(&timesbuf);
 
     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);
@@ -4543,7 +4565,7 @@ PP(pp_tms)
     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);
@@ -4587,11 +4609,16 @@ PP(pp_gmtime)
     }
     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;
+	    }
 	}
     }
 
@@ -4617,24 +4644,26 @@ PP(pp_gmtime)
     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 */
@@ -4848,7 +4877,7 @@ PP(pp_ghostent)
 	}
 #endif
 
-    if (GIMME != G_ARRAY) {
+    if (GIMME_V != G_ARRAY) {
 	PUSHs(sv = sv_newmortal());
 	if (hent) {
 	    if (which == OP_GHBYNAME) {
@@ -4935,7 +4964,7 @@ PP(pp_gnetent)
 #endif
 
     EXTEND(SP, 4);
-    if (GIMME != G_ARRAY) {
+    if (GIMME_V != G_ARRAY) {
 	PUSHs(sv = sv_newmortal());
 	if (nent) {
 	    if (which == OP_GNBYNAME)
@@ -4999,7 +5028,7 @@ PP(pp_gprotoent)
 #endif
 
     EXTEND(SP, 3);
-    if (GIMME != G_ARRAY) {
+    if (GIMME_V != G_ARRAY) {
 	PUSHs(sv = sv_newmortal());
 	if (pent) {
 	    if (which == OP_GPBYNAME)
@@ -5065,7 +5094,7 @@ PP(pp_gservent)
 #endif
 
     EXTEND(SP, 4);
-    if (GIMME != G_ARRAY) {
+    if (GIMME_V != G_ARRAY) {
 	PUSHs(sv = sv_newmortal());
 	if (sent) {
 	    if (which == OP_GSBYNAME) {
@@ -5301,7 +5330,7 @@ PP(pp_gpwent)
     }
 
     EXTEND(SP, 10);
-    if (GIMME != G_ARRAY) {
+    if (GIMME_V != G_ARRAY) {
 	PUSHs(sv = sv_newmortal());
 	if (pwent) {
 	    if (which == OP_GPWNAM)
@@ -5443,7 +5472,7 @@ PP(pp_ggrent)
 #endif
 
     EXTEND(SP, 4);
-    if (GIMME != G_ARRAY) {
+    if (GIMME_V != G_ARRAY) {
 	SV * const sv = sv_newmortal();
 
 	PUSHs(sv);