Re: [perl #33892] Add Interix support

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

diff --git a/doio.c b/doio.c
index 40287f9..12ec5fe 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,7 +1,7 @@
 /*    doio.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -15,6 +15,11 @@
  * chattering, into calmer and more level reaches."
  */
 
+/* This file contains functions that do the actual I/O on behalf of ops.
+ * For example, pp_print() calls the do_print() function in this file for
+ * each argument needing printing.
+ */
+
 #include "EXTERN.h"
 #define PERL_IN_DOIO_C
 #include "perl.h"
@@ -48,9 +53,7 @@
 #  define OPEN_EXCL 0
 #endif
 
-#if !defined(NSIG) || defined(M_UNIX) || defined(__unix) || defined(M_XENIX)
 #include <signal.h>
-#endif
 
 bool
 Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
@@ -262,7 +265,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                errno = EPIPE;
                goto say_false;
            }
-           if (strNE(name,"-") || num_svs)
+           if ((*name == '-' && name[1] == '\0') || num_svs)
                TAINT_ENV();
            TAINT_PROPER("piped open");
            if (!num_svs && name[len-1] == '|') {
@@ -480,7 +483,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                errno = EPIPE;
                goto say_false;
            }
-           if (strNE(name,"-") || num_svs)
+           if (!(*name == '-' && name[1] == '\0') || num_svs)
                TAINT_ENV();
            TAINT_PROPER("piped open");
            mode[0] = 'r';
@@ -516,7 +519,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                strcat(mode, "b");
            else if (in_crlf)
                strcat(mode, "t");
-           if (strEQ(name,"-")) {
+           if (*name == '-' && name[1] == '\0') {
                fp = PerlIO_stdin();
                IoTYPE(io) = IoTYPE_STD;
            }
@@ -725,11 +728,13 @@ Perl_nextargv(pTHX_ register GV *gv)
     if (PL_filemode & (S_ISUID|S_ISGID)) {
        PerlIO_flush(IoIFP(GvIOn(PL_argvoutgv)));  /* chmod must follow last write */
 #ifdef HAS_FCHMOD
-       (void)fchmod(PL_lastfd,PL_filemode);
+       if (PL_lastfd != -1)
+           (void)fchmod(PL_lastfd,PL_filemode);
 #else
        (void)PerlLIO_chmod(PL_oldname,PL_filemode);
 #endif
     }
+    PL_lastfd = -1;
     PL_filemode = 0;
     if (!GvAV(gv))
         return Nullfp;
@@ -1136,7 +1141,7 @@ Perl_mode_from_discipline(pTHX_ SV *discp)
            if (*s == ':') {
                switch (s[1]) {
                case 'r':
-                   if (len > 3 && strnEQ(s+1, "raw", 3)
+                   if (s[2] == 'a' && s[3] == 'w'
                        && (!s[4] || s[4] == ':' || isSPACE(s[4])))
                    {
                        mode = O_BINARY;
@@ -1146,7 +1151,7 @@ Perl_mode_from_discipline(pTHX_ SV *discp)
                    }
                    /* FALL THROUGH */
                case 'c':
-                   if (len > 4 && strnEQ(s+1, "crlf", 4)
+                   if (s[2] == 'r' && s[3] == 'l' && s[4] == 'f'
                        && (!s[5] || s[5] == ':' || isSPACE(s[5])))
                    {
                        mode = O_TEXT;
@@ -1172,6 +1177,7 @@ fail_discipline:
 #ifndef PERLIO_LAYERS
                Perl_croak(aTHX_ "IO layers (like '%.*s') unavailable", end-s, s);
 #else
+               len -= end-s;
                s = end;
 #endif
            }
@@ -1270,7 +1276,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
     switch (SvTYPE(sv)) {
     case SVt_NULL:
        if (ckWARN(WARN_UNINITIALIZED))
-           report_uninit();
+           report_uninit(sv);
        return TRUE;
     case SVt_IV:
        if (SvIOK(sv)) {
@@ -1338,6 +1344,9 @@ Perl_my_stat(pTHX)
            return (PL_laststatval = -1);
        }
     }
+    else if (PL_op->op_private & OPpFT_STACKED) {
+       return PL_laststatval;
+    }
     else {
        SV* sv = POPs;
        char *s;
@@ -1364,6 +1373,8 @@ Perl_my_stat(pTHX)
     }
 }
 
+static char no_prev_lstat[] = "The stat preceding -l _ wasn't an lstat";
+
 I32
 Perl_my_lstat(pTHX)
 {
@@ -1374,7 +1385,7 @@ Perl_my_lstat(pTHX)
        EXTEND(SP,1);
        if (cGVOP_gv == PL_defgv) {
            if (PL_laststype != OP_LSTAT)
-               Perl_croak(aTHX_ "The stat preceding -l _ wasn't an lstat");
+               Perl_croak(aTHX_ no_prev_lstat);
            return PL_laststatval;
        }
        if (ckWARN(WARN_IO)) {
@@ -1383,6 +1394,9 @@ Perl_my_lstat(pTHX)
            return (PL_laststatval = -1);
        }
     }
+    else if (ckWARN(WARN_IO) && PL_laststype != OP_LSTAT
+           && (PL_op->op_private & OPpFT_STACKED))
+       Perl_croak(aTHX_ no_prev_lstat);
 
     PL_laststype = OP_LSTAT;
     PL_statgv = Nullgv;