Re: [perl #33892] Add Interix support

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

diff --git a/doio.c b/doio.c
index 7e13f1f..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"
@@ -260,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] == '|') {
@@ -478,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';
@@ -514,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;
            }
@@ -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)) {