Simplify logic in pp_sys.c:pp_fttty

[perl5.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 9c6bc99..b8c212c 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -248,6 +248,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresuid(euid, ruid, (Uid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: entering effective %s failed */
        Perl_croak(aTHX_ "entering effective uid failed");
 #endif
 
@@ -261,6 +262,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresgid(egid, rgid, (Gid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: entering effective %s failed */
        Perl_croak(aTHX_ "entering effective gid failed");
 #endif
 
@@ -273,6 +275,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresuid(ruid, euid, (Uid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: leaving effective %s failed */
        Perl_croak(aTHX_ "leaving effective uid failed");
 
 #ifdef HAS_SETREGID
@@ -282,6 +285,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode)
     if (setresgid(rgid, egid, (Gid_t)-1))
 #endif
 #endif
+       /* diag_listed_as: leaving effective %s failed */
        Perl_croak(aTHX_ "leaving effective gid failed");
 
     return res;
@@ -1013,7 +1017,10 @@ PP(pp_dbmopen)
     if (SvIV(right))
        mPUSHu(O_RDWR|O_CREAT);
     else
+    {
        mPUSHu(O_RDWR);
+       if (!SvOK(right)) right = &PL_sv_no;
+    }
     PUSHs(right);
     PUTBACK;
     call_sv(MUTABLE_SV(GvCV(gv)), G_SCALAR);
@@ -3241,7 +3248,6 @@ PP(pp_fttty)
     dSP;
     int fd;
     GV *gv;
-    SV *tmpsv = NULL;
     char *name = NULL;
     STRLEN namelen;
 
@@ -3251,20 +3257,18 @@ PP(pp_fttty)
 
     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP_gv;
-    else if (!(gv = MAYBE_DEREF_GV_nomg(TOPs))) {
-       tmpsv = POPs;
+    else {
+      SV *tmpsv = POPs;
+      if (!(gv = MAYBE_DEREF_GV_nomg(tmpsv))) {
        name = SvPV_nomg(tmpsv, namelen);
        gv = gv_fetchpvn_flags(name, namelen, SvUTF8(tmpsv), SVt_PVIO);
+      }
     }
 
     if (GvIO(gv) && IoIFP(GvIOp(gv)))
        fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
-    else if (tmpsv && SvOK(tmpsv)) {
-       if (isDIGIT(*name))
+    else if (name && isDIGIT(*name))
            fd = atoi(name);
-       else 
-           RETPUSHUNDEF;
-    }
     else
        RETPUSHUNDEF;
     if (PerlLIO_isatty(fd))
@@ -3290,7 +3294,7 @@ PP(pp_fttext)
     STDCHAR tbuf[512];
     register STDCHAR *s;
     register IO *io;
-    register SV *sv;
+    register SV *sv = NULL;
     GV *gv;
     PerlIO *fp;
 
@@ -3300,7 +3304,9 @@ PP(pp_fttext)
 
     if (PL_op->op_flags & OPf_REF)
        gv = cGVOP_gv;
-    else gv = MAYBE_DEREF_GV_nomg(TOPs);
+    else if (PL_op->op_private & OPpFT_STACKED)
+       gv = PL_defgv;
+    else sv = POPs, gv = MAYBE_DEREF_GV_nomg(sv);
 
     if (gv) {
        EXTEND(SP, 1);
@@ -3344,13 +3350,12 @@ PP(pp_fttext)
                len = 512;
        }
        else {
-           report_evil_fh(cGVOP_gv);
+           report_evil_fh(gv);
            SETERRNO(EBADF,RMS_IFI);
            RETPUSHUNDEF;
        }
     }
     else {
-       sv = POPs;
       really_filename:
        PL_statgv = NULL;
        PL_laststype = OP_STAT;
@@ -4112,9 +4117,17 @@ PP(pp_system)
        Pid_t childpid;
        int pp[2];
        I32 did_pipes = 0;
+#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+       sigset_t newset, oldset;
+#endif
 
        if (PerlProc_pipe(pp) >= 0)
            did_pipes = 1;
+#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+       sigemptyset(&newset);
+       sigaddset(&newset, SIGCHLD);
+       sigprocmask(SIG_BLOCK, &newset, &oldset);
+#endif
        while ((childpid = PerlProc_fork()) == -1) {
            if (errno != EAGAIN) {
                value = -1;
@@ -4124,6 +4137,9 @@ PP(pp_system)
                    PerlLIO_close(pp[0]);
                    PerlLIO_close(pp[1]);
                }
+#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+               sigprocmask(SIG_SETMASK, &oldset, NULL);
+#endif
                RETURN;
            }
            sleep(5);
@@ -4142,6 +4158,9 @@ PP(pp_system)
                result = wait4pid(childpid, &status, 0);
            } while (result == -1 && errno == EINTR);
 #ifndef PERL_MICRO
+#ifdef HAS_SIGPROCMASK
+           sigprocmask(SIG_SETMASK, &oldset, NULL);
+#endif
            (void)rsignal_restore(SIGINT, &ihand);
            (void)rsignal_restore(SIGQUIT, &qhand);
 #endif
@@ -4172,6 +4191,9 @@ PP(pp_system)
            XPUSHi(STATUS_CURRENT);
            RETURN;
        }
+#if (defined(HAS_SIGPROCMASK) && !defined(PERL_MICRO))
+       sigprocmask(SIG_SETMASK, &oldset, NULL);
+#endif
        if (did_pipes) {
            PerlLIO_close(pp[0]);
 #if defined(HAS_FCNTL) && defined(F_SETFD)
@@ -4461,17 +4483,20 @@ PP(pp_gmtime)
        NV input = Perl_floor(POPn);
        when = (Time64_T)input;
        if (when != input) {
+           /* diag_listed_as: gmtime(%f) too large */
            Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                           "%s(%.0" NVff ") too large", opname, input);
        }
     }
 
     if ( TIME_LOWER_BOUND > when ) {
+       /* diag_listed_as: gmtime(%f) too small */
        Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                       "%s(%.0" NVff ") too small", opname, when);
        err = NULL;
     }
     else if( when > TIME_UPPER_BOUND ) {
+       /* diag_listed_as: gmtime(%f) too small */
        Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                       "%s(%.0" NVff ") too large", opname, when);
        err = NULL;