Re: [PATCH] Re: Modulus operator inconsistency

[p5sagit/p5-mst-13.2.git] / doio.c

diff --git a/doio.c b/doio.c
index 2577b2f..0520992 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,6 +1,6 @@
 /*    doio.c
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (c) 1991-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -140,18 +140,44 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     if (as_raw) {
         /* sysopen style args, i.e. integer mode and permissions */
        STRLEN ix = 0;
-       if (num_svs != 0) {
-            Perl_croak(aTHX_ "panic: sysopen with multiple args");
-       }
-       if (rawmode & (O_WRONLY|O_RDWR|O_CREAT
+       int appendtrunc =
+            0
 #ifdef O_APPEND        /* Not fully portable. */
-                      |O_APPEND
+            |O_APPEND
 #endif
 #ifdef O_TRUNC /* Not fully portable. */
-                      |O_TRUNC
+            |O_TRUNC
 #endif
-                      ))
-           TAINT_PROPER("sysopen");
+            ;
+       int modifyingmode =
+            O_WRONLY|O_RDWR|O_CREAT|appendtrunc;
+       int ismodifying;
+
+       if (num_svs != 0) {
+            Perl_croak(aTHX_ "panic: sysopen with multiple args");
+       }
+       /* It's not always
+
+          O_RDONLY 0
+          O_WRONLY 1
+          O_RDWR   2
+
+          It might be (in OS/390 and Mac OS Classic it is)
+
+          O_WRONLY 1
+          O_RDONLY 2
+          O_RDWR   3
+
+          This means that simple & with O_RDWR would look
+          like O_RDONLY is present.  Therefore we have to
+          be more careful.
+       */
+       if ((ismodifying = (rawmode & modifyingmode))) {
+            if ((ismodifying & O_WRONLY) == O_WRONLY ||
+                (ismodifying & O_RDWR)   == O_RDWR   ||
+                (ismodifying & (O_CREAT|appendtrunc)))
+                 TAINT_PROPER("sysopen");
+       }
        mode[ix++] = '#'; /* Marker to openn to use numeric "sysopen" */
 
 #if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
@@ -951,21 +977,7 @@ Perl_do_eof(pTHX_ GV *gv)
     if (!io)
        return TRUE;
     else if (ckWARN(WARN_IO) && (IoTYPE(io) == IoTYPE_WRONLY))
-    {
-       /* integrate to report_evil_fh()? */
-        char *name = NULL;
-       if (isGV(gv)) {
-           SV* sv = sv_newmortal();
-           gv_efullname4(sv, gv, Nullch, FALSE);
-           name = SvPV_nolen(sv);
-       }
-       if (name && *name)
-           Perl_warner(aTHX_ WARN_IO,
-                       "Filehandle %s opened only for output", name);
-       else
-           Perl_warner(aTHX_ WARN_IO,
-                       "Filehandle opened only for output");
-    }
+       report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY);
 
     while (IoIFP(io)) {
 
@@ -985,7 +997,7 @@ Perl_do_eof(pTHX_ GV *gv)
                PerlIO_set_cnt(IoIFP(io),-1);
        }
        if (PL_op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */
-           if (!nextargv(PL_argvgv))   /* get another fp handy */
+           if (gv != PL_argvgv || !nextargv(gv))       /* get another fp handy */
                return TRUE;
        }
        else
@@ -1108,8 +1120,8 @@ Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
   * This is a stub for any XS code which might have been calling it.
   */
  char *name = ":raw";
-#ifdef PERLIO_CRLF
- if (!(mode & O_BINARY)))
+#ifdef PERLIO_USING_CRLF
+ if (!(mode & O_BINARY))
      name = ":crlf";
 #endif
  return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
@@ -1211,7 +1223,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
        }
        else if (DO_UTF8(sv)) {
            if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE)
-               && ckWARN(WARN_UTF8))
+               && ckWARN_d(WARN_UTF8))
            {
                Perl_warner(aTHX_ WARN_UTF8, "Wide character in print");
            }
@@ -1296,13 +1308,22 @@ Perl_my_lstat(pTHX)
                Perl_croak(aTHX_ "The stat preceding -l _ wasn't an lstat");
            return PL_laststatval;
        }
-       Perl_croak(aTHX_ "You can't use -l on a filehandle");
+       if (ckWARN(WARN_IO)) {
+           Perl_warner(aTHX_ WARN_IO, "Use of -l on filehandle %s",
+                   GvENAME(cGVOP_gv));
+           return (PL_laststatval = -1);
+       }
     }
 
     PL_laststype = OP_LSTAT;
     PL_statgv = Nullgv;
     sv = POPs;
     PUTBACK;
+    if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV && ckWARN(WARN_IO)) {
+       Perl_warner(aTHX_ WARN_IO, "Use of -l on filehandle %s",
+               GvENAME((GV*) SvRV(sv)));
+       return (PL_laststatval = -1);
+    }
     sv_setpv(PL_statname,SvPV(sv, n_a));
     PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache);
     if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
@@ -2120,6 +2141,8 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 #endif /* SYSV IPC */
 
 /*
+=head1 IO Functions
+
 =for apidoc start_glob
 
 Function called by C<do_readline> to spawn a glob (or do the glob inside