Add back the EBCDIC character range tests (for matching).

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

diff --git a/doio.c b/doio.c
index 94a4329..53863b6 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,6 +1,6 @@
 /*    doio.c
  *
- *    Copyright (c) 1991-2000, Larry Wall
+ *    Copyright (c) 1991-2001, 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.
@@ -55,8 +55,8 @@ bool
 Perl_do_open(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
             int rawmode, int rawperm, PerlIO *supplied_fp)
 {
-    return do_open9(gv, name, len, as_raw, rawmode, rawperm,
-                   supplied_fp, Nullsv, 0);
+    return do_openn(gv, name, len, as_raw, rawmode, rawperm,
+                   supplied_fp, (SV **) NULL, 0);
 }
 
 bool
@@ -64,6 +64,15 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
              int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
              I32 num_svs)
 {
+    return do_openn(gv, name, len, as_raw, rawmode, rawperm,
+                   supplied_fp, &svs, 1);
+}
+
+bool
+Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
+             int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp,
+             I32 num_svs)
+{
     register IO *io = GvIOn(gv);
     PerlIO *saveifp = Nullfp;
     PerlIO *saveofp = Nullfp;
@@ -75,8 +84,8 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     bool was_fdopen = FALSE;
     bool in_raw = 0, in_crlf = 0, out_raw = 0, out_crlf = 0;
     char *type  = NULL;
-    char *deftype = NULL;
     char mode[4];              /* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */
+    SV *svs = (num_svs) ? *svp : Nullsv;
 
     Zero(mode,sizeof(mode),char);
     PL_forkprocess = 1;                /* assume true if no fork */
@@ -206,7 +215,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            len  = tend-type;
        }
        IoTYPE(io) = *type;
-       if (*type == IoTYPE_RDWR && (!num_svs || tend > type+1 && tend[-1] != IoTYPE_PIPE)) { /* scary */
+       if ((*type == IoTYPE_RDWR) && ((!num_svs || tend > type+1 && tend[-1] != IoTYPE_PIPE))) { /* scary */
            mode[1] = *type++;
            writing = 1;
        }
@@ -529,6 +538,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
     if (type) {
        while (isSPACE(*type)) type++;
        if (*type) {
+          errno = 0;
           if (PerlIO_apply_layers(aTHX_ IoIFP(io),mode,type) != 0) {
                goto say_false;
           }
@@ -1158,13 +1168,12 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
        /* FALL THROUGH */
     default:
        if (PerlIO_isutf8(fp)) {
-           tmps = SvPVutf8(sv, len);
-       }
-       else {
-           if (DO_UTF8(sv))
-               sv_utf8_downgrade(sv, FALSE);
-           tmps = SvPV(sv, len);
+           if (!SvUTF8(sv))
+               sv_utf8_upgrade(sv = sv_mortalcopy(sv));
        }
+       else if (DO_UTF8(sv))
+           sv_utf8_downgrade((sv = sv_mortalcopy(sv)), FALSE);
+       tmps = SvPV(sv, len);
        break;
     }
     /* To detect whether the process is about to overstep its
@@ -1181,7 +1190,7 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
 I32
 Perl_my_stat(pTHX)
 {
-    djSP;
+    dSP;
     IO *io;
     GV* gv;
 
@@ -1234,7 +1243,7 @@ Perl_my_stat(pTHX)
 I32
 Perl_my_lstat(pTHX)
 {
-    djSP;
+    dSP;
     SV *sv;
     STRLEN n_a;
     if (PL_op->op_flags & OPf_REF) {