silence some gcc -pendantic warnings

[perl5.git] / doio.c

diff --git a/doio.c b/doio.c
index 1df3535..79ab20c 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -377,6 +377,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
                else {
                    PerlIO *that_fp = NULL;
                     int wanted_fd;
+                    UV uv;
                    if (num_svs > 1) {
                        /* diag_listed_as: More than one argument to '%s' open */
                        Perl_croak(aTHX_ "More than one argument to '%c&' open",IoTYPE(io));
@@ -390,8 +391,11 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
                         wanted_fd = SvUV(*svp);
                        num_svs = 0;
                    }
-                   else if (isDIGIT(*type)) {
-                        wanted_fd = grok_atou(type, NULL);
+                   else if (isDIGIT(*type)
+                        && grok_atoUV(type, &uv, NULL)
+                        && uv <= INT_MAX
+                    ) {
+                        wanted_fd = (int)uv;
                    }
                    else {
                        const IO* thatio;
@@ -434,8 +438,11 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len,
                            else if (IoTYPE(thatio) == IoTYPE_SOCKET)
                                IoTYPE(io) = IoTYPE_SOCKET;
                        }
-                       else
-                           wanted_fd = -1;
+                        else {
+                            SETERRNO(EBADF, RMS_IFI);
+                            fp = NULL;
+                            goto say_false;
+                        }
                    }
                    if (!num_svs)
                        type = NULL;
@@ -790,7 +797,7 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname,
     }
     return TRUE;
 
-say_false:
+  say_false:
     IoIFP(io) = saveifp;
     IoOFP(io) = saveofp;
     IoTYPE(io) = savetype;
@@ -806,7 +813,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
 
     if (!PL_argvoutgv)
        PL_argvoutgv = gv_fetchpvs("ARGVOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
-    if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) {
+    if (io && (IoFLAGS(io) & (IOf_ARGV|IOf_START)) == (IOf_ARGV|IOf_START)) {
        IoFLAGS(io) &= ~IOf_START;
        if (PL_inplace) {
            assert(PL_defoutgv);
@@ -1043,7 +1050,7 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
        }
        return FALSE;
     }
-    retval = io_close(io, not_implicit);
+    retval = io_close(io, NULL, not_implicit, FALSE);
     if (not_implicit) {
        IoLINES(io) = 0;
        IoPAGE(io) = 0;
@@ -1054,7 +1061,7 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
 }
 
 bool
-Perl_io_close(pTHX_ IO *io, bool not_implicit)
+Perl_io_close(pTHX_ IO *io, GV *gv, bool not_implicit, bool warn_on_fail)
 {
     bool retval = FALSE;
 
@@ -1093,6 +1100,20 @@ Perl_io_close(pTHX_ IO *io, bool not_implicit)
            }
        }
        IoOFP(io) = IoIFP(io) = NULL;
+
+       if (warn_on_fail && !retval) {
+           if (gv)
+               Perl_ck_warner_d(aTHX_ packWARN(WARN_IO),
+                               "Warning: unable to close filehandle %"
+                                HEKf" properly: %"SVf,
+                                HEKfARG(GvNAME_HEK(gv)),
+                                 SVfARG(get_sv("!",GV_ADD)));
+           else
+               Perl_ck_warner_d(aTHX_ packWARN(WARN_IO),
+                               "Warning: unable to close filehandle "
+                               "properly: %"SVf,
+                                SVfARG(get_sv("!",GV_ADD)));
+       }
     }
     else if (not_implicit) {
        SETERRNO(EBADF,SS_IVCHAN);
@@ -1233,7 +1254,7 @@ Perl_mode_from_discipline(pTHX_ const char *s, STRLEN len)
            }
            else {
                const char *end;
-fail_discipline:
+  fail_discipline:
                end = strchr(s+1, ':');
                if (!end)
                    end = s+len;
@@ -2566,11 +2587,5 @@ Perl_vms_start_glob
 }
 
 /*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
  * ex: set ts=8 sts=4 sw=4 et:
  */