This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
t/io/crlf.t: Generalize for non-ASCII platforms
[perl5.git] / pp_sys.c
index 09eead6..e2f8edf 100644 (file)
--- 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);
@@ -2539,7 +2555,7 @@ PP(pp_bind)
     else
        RETPUSHUNDEF;
 
-nuts:
+  nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
@@ -2560,7 +2576,7 @@ PP(pp_listen)
     else
        RETPUSHUNDEF;
 
-nuts:
+  nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
     RETPUSHUNDEF;
@@ -2622,11 +2638,11 @@ PP(pp_accept)
     PUSHp(namebuf, len);
     RETURN;
 
-nuts:
+  nuts:
     report_evil_fh(ggv);
     SETERRNO(EBADF,SS_IVCHAN);
 
-badexit:
+  badexit:
     RETPUSHUNDEF;
 
 }
@@ -2644,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;
@@ -2724,10 +2740,10 @@ PP(pp_ssockopt)
     }
     RETURN;
 
-nuts:
+  nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
-nuts2:
+  nuts2:
     RETPUSHUNDEF;
 
 }
@@ -2788,10 +2804,10 @@ PP(pp_getpeername)
     PUSHs(sv);
     RETURN;
 
-nuts:
+  nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,SS_IVCHAN);
-nuts2:
+  nuts2:
     RETPUSHUNDEF;
 }
 
@@ -3617,11 +3633,13 @@ PP(pp_chdir)
 #endif
     RETURN;
 
+#ifdef HAS_FCHDIR
  nuts:
     report_evil_fh(gv);
     SETERRNO(EBADF,RMS_IFI);
     PUSHi(0);
     RETURN;
+#endif
 }
 
 
@@ -3927,7 +3945,7 @@ PP(pp_open_dir)
        goto nope;
 
     RETPUSHYES;
-nope:
+  nope:
     if (!errno)
        SETERRNO(EBADF,RMS_DIR);
     RETPUSHUNDEF;
@@ -3947,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);
@@ -3978,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;
@@ -4011,7 +4029,7 @@ PP(pp_telldir)
 
     PUSHi( PerlDir_tell(IoDIRP(io)) );
     RETURN;
-nope:
+  nope:
     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
@@ -4037,7 +4055,7 @@ PP(pp_seekdir)
     (void)PerlDir_seek(IoDIRP(io), along);
 
     RETPUSHYES;
-nope:
+  nope:
     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
@@ -4061,7 +4079,7 @@ PP(pp_rewinddir)
     }
     (void)PerlDir_rewind(IoDIRP(io));
     RETPUSHYES;
-nope:
+  nope:
     if (!errno)
        SETERRNO(EBADF,RMS_ISI);
     RETPUSHUNDEF;
@@ -4094,7 +4112,7 @@ PP(pp_closedir)
     IoDIRP(io) = 0;
 
     RETPUSHYES;
-nope:
+  nope:
     if (!errno)
        SETERRNO(EBADF,RMS_IFI);
     RETPUSHUNDEF;
@@ -4536,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);
@@ -4547,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);
@@ -4591,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;
+           }
        }
     }
 
@@ -4621,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 */
@@ -4852,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) {
@@ -4939,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)
@@ -5003,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)
@@ -5069,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) {
@@ -5305,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)
@@ -5447,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);