Integrate mainline

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

diff --git a/doio.c b/doio.c
index 9dbb737..87e5901 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -141,12 +141,14 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int 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");
+            Perl_croak(aTHX_ "panic: sysopen with multiple args");
        }
+       if (rawmode & (O_WRONLY|O_RDWR|O_APPEND|O_CREAT|O_TRUNC))
+           TAINT_PROPER("sysopen");
        mode[ix++] = '#'; /* Marker to openn to use numeric "sysopen" */
 
 #if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
-       rawmode |= O_LARGEFILE;
+       rawmode |= O_LARGEFILE; /* Transparently largefiley. */
 #endif
 
 #ifndef O_ACCMODE
@@ -193,7 +195,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        num_svs = 1;
        svp = &namesv;
         type = Nullch;
-       fp = PerlIO_openn(aTHX_ type,mode, -1, rawmode, rawperm, NULL, num_svs, svp);
+       fp = PerlIO_openn(aTHX_ type, mode, -1, rawmode, rawperm, NULL, num_svs, svp);
     }
     else {
        /* Regular (non-sys) open */
@@ -211,7 +213,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        if (num_svs) {
            /* New style explict name, type is just mode and discipline/layer info */
            STRLEN l = 0;
-           name = SvOK(*svp) && (*svp != &PL_sv_undef) ? SvPV(*svp, l) : "";
+           name = SvOK(*svp) ? SvPV(*svp, l) : "";
            len = (I32)l;
            name = savepvn(name, len);
            SAVEFREEPV(name);
@@ -504,11 +506,13 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     if (ckWARN(WARN_IO)) {
        if ((IoTYPE(io) == IoTYPE_RDONLY) &&
            (fp == PerlIO_stdout() || fp == PerlIO_stderr())) {
-               Perl_warner(aTHX_ WARN_IO, "'std%s' opened only for input",
-                               (fp == PerlIO_stdout()) ? "out" : "err");
+               Perl_warner(aTHX_ WARN_IO,
+                           "Filehandle STD%s opened only for input",
+                           (fp == PerlIO_stdout()) ? "OUT" : "ERR");
        }
        else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) {
-               Perl_warner(aTHX_ WARN_IO, "'stdin' opened only for output");
+               Perl_warner(aTHX_ WARN_IO,
+                           "Filehandle STDIN opened only for output");
        }
     }
 
@@ -555,13 +559,16 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        if (savefd != fd) {
            Pid_t pid;
            SV *sv;
-           PerlLIO_dup2(fd, savefd);
+           if (PerlLIO_dup2(fd, savefd) < 0) {
+               (void)PerlIO_close(fp);
+               goto say_false;
+           }
 #ifdef VMS
            if (savefd != PerlIO_fileno(PerlIO_stdin())) {
              char newname[FILENAME_MAX+1];
              if (fgetname(fp, newname)) {
-               if (savefd == PerlIO_fileno(PerlIO_stdout())) Perl_vmssetuserlnm("SYS$OUTPUT", newname);
-               if (savefd == PerlIO_fileno(PerlIO_stderr())) Perl_vmssetuserlnm("SYS$ERROR",  newname);
+               if (fd == PerlIO_fileno(PerlIO_stdout())) Perl_vmssetuserlnm(aTHX_ "SYS$OUTPUT", newname);
+               if (fd == PerlIO_fileno(PerlIO_stderr())) Perl_vmssetuserlnm(aTHX_ "SYS$ERROR",  newname);
              }
            }
 #endif
@@ -1204,8 +1211,11 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
            if (!SvUTF8(sv))
                sv_utf8_upgrade(sv = sv_mortalcopy(sv));
        }
-       else if (DO_UTF8(sv))
-           sv_utf8_downgrade((sv = sv_mortalcopy(sv)), FALSE);
+       else if (DO_UTF8(sv)) {
+           if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE)) {
+               Perl_warner(aTHX_ WARN_UTF8, "Wide character in print");
+           }
+       }
        tmps = SvPV(sv, len);
        break;
     }