Re: hv.c patch - pathological hashes too easy
[p5sagit/p5-mst-13.2.git] / doio.c
diff --git a/doio.c b/doio.c
index a706fbf..438139f 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,6 +1,7 @@
 /*    doio.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2003, 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.
@@ -323,12 +324,13 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                    if (num_svs > 1) {
                        Perl_croak(aTHX_ "More than one argument to '%c&' open",IoTYPE(io));
                    }
+                   /*SUPPRESS 530*/
+                   for (; isSPACE(*type); type++) ;
                    if (num_svs && (SvIOK(*svp) || (SvPOK(*svp) && looks_like_number(*svp)))) {
                        fd = SvUV(*svp);
+                       num_svs = 0;
                    }
                    else if (isDIGIT(*type)) {
-                       /*SUPPRESS 530*/
-                       for (; isSPACE(*type); type++) ;
                        fd = atoi(type);
                    }
                    else {
@@ -338,8 +340,6 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                        }
                        else {
                            GV *thatgv;
-                           /*SUPPRESS 530*/
-                           for (; isSPACE(*type); type++) ;
                            thatgv = gv_fetchpv(type,FALSE,SVt_PVIO);
                            thatio = GvIO(thatgv);
                        }
@@ -536,12 +536,14 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        if ((IoTYPE(io) == IoTYPE_RDONLY) &&
            (fp == PerlIO_stdout() || fp == PerlIO_stderr())) {
                Perl_warner(aTHX_ packWARN(WARN_IO),
-                           "Filehandle STD%s opened only for input",
-                           (fp == PerlIO_stdout()) ? "OUT" : "ERR");
+                           "Filehandle STD%s reopened as %s only for input",
+                           ((fp == PerlIO_stdout()) ? "OUT" : "ERR"),
+                           GvENAME(gv));
        }
        else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) {
                Perl_warner(aTHX_ packWARN(WARN_IO),
-                           "Filehandle STDIN opened only for output");
+                           "Filehandle STDIN reopened as %s only for output",
+                           GvENAME(gv));
        }
     }
 
@@ -716,6 +718,8 @@ Perl_nextargv(pTHX_ register GV *gv)
 #endif
     }
     PL_filemode = 0;
+    if (!GvAV(gv))
+        return Nullfp;
     while (av_len(GvAV(gv)) >= 0) {
        STRLEN oldlen;
        sv = av_shift(GvAV(gv));
@@ -772,8 +776,8 @@ Perl_nextargv(pTHX_ register GV *gv)
                    {
                        if (ckWARN_d(WARN_INPLACE))     
                            Perl_warner(aTHX_ packWARN(WARN_INPLACE),
-                             "Can't do inplace edit: %s would not be unique",
-                             SvPVX(sv));
+                             "Can't do inplace edit: %"SVf" would not be unique",
+                             sv);
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -783,8 +787,8 @@ Perl_nextargv(pTHX_ register GV *gv)
                    if (PerlLIO_rename(PL_oldname,SvPVX(sv)) < 0) {
                        if (ckWARN_d(WARN_INPLACE))     
                            Perl_warner(aTHX_ packWARN(WARN_INPLACE),
-                             "Can't rename %s to %s: %s, skipping file",
-                             PL_oldname, SvPVX(sv), Strerror(errno) );
+                             "Can't rename %s to %"SVf": %s, skipping file",
+                             PL_oldname, sv, Strerror(errno) );
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -799,8 +803,8 @@ Perl_nextargv(pTHX_ register GV *gv)
                    if (link(PL_oldname,SvPVX(sv)) < 0) {
                        if (ckWARN_d(WARN_INPLACE))     
                            Perl_warner(aTHX_ packWARN(WARN_INPLACE),
-                             "Can't rename %s to %s: %s, skipping file",
-                             PL_oldname, SvPVX(sv), Strerror(errno) );
+                             "Can't rename %s to %"SVf": %s, skipping file",
+                             PL_oldname, sv, Strerror(errno) );
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -920,8 +924,8 @@ Perl_do_pipe(pTHX_ SV *sv, GV *rgv, GV *wgv)
 
     if (PerlProc_pipe(fd) < 0)
        goto badexit;
-    IoIFP(rstio) = PerlIO_fdopen(fd[0], "r");
-    IoOFP(wstio) = PerlIO_fdopen(fd[1], "w");
+    IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPESOCK_MODE);
+    IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPESOCK_MODE);
     IoOFP(rstio) = IoIFP(rstio);
     IoIFP(wstio) = IoOFP(wstio);
     IoTYPE(rstio) = IoTYPE_RDONLY;
@@ -1265,7 +1269,8 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
     default:
        if (PerlIO_isutf8(fp)) {
            if (!SvUTF8(sv))
-               sv_utf8_upgrade(sv = sv_mortalcopy(sv));
+               sv_utf8_upgrade_flags(sv = sv_mortalcopy(sv),
+                                     SV_GMAGIC|SV_UTF8_NO_ENCODING);
        }
        else if (DO_UTF8(sv)) {
            if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE)
@@ -1319,7 +1324,7 @@ Perl_my_stat(pTHX)
     else {
        SV* sv = POPs;
        char *s;
-       STRLEN n_a;
+       STRLEN len;
        PUTBACK;
        if (SvTYPE(sv) == SVt_PVGV) {
            gv = (GV*)sv;
@@ -1330,9 +1335,10 @@ Perl_my_stat(pTHX)
            goto do_fstat;
        }
 
-       s = SvPV(sv, n_a);
+       s = SvPV(sv, len);
        PL_statgv = Nullgv;
-       sv_setpv(PL_statname, s);
+       sv_setpvn(PL_statname, s, len);
+       s = SvPVX(PL_statname);         /* s now NUL-terminated */
        PL_laststype = OP_STAT;
        PL_laststatval = PerlLIO_stat(s, &PL_statcache);
        if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n'))
@@ -1639,10 +1645,10 @@ nothing in the core.
        if (mark == sp)
            break;
        s = SvPVx(*++mark, n_a);
-       if (isUPPER(*s)) {
+       if (isALPHA(*s)) {
            if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
                s += 3;
-           if (!(val = whichsig(s)))
+           if ((val = whichsig(s)) < 0)
                Perl_croak(aTHX_ "Unrecognized signal name \"%s\"",s);
        }
        else
@@ -1742,22 +1748,23 @@ nothing in the core.
            SV* modified = *++mark;
            void * utbufp = &utbuf;
 
-           /* be like C, and if both times are undefined, let the C
-              library figure out what to do.  This usually means
-              "current time" */
+           /* Be like C, and if both times are undefined, let the C
+            * library figure out what to do.  This usually means
+            * "current time". */
 
            if ( accessed == &PL_sv_undef && modified == &PL_sv_undef )
-             utbufp = NULL;
-
-           Zero(&utbuf, sizeof utbuf, char);
+                utbufp = NULL;
+           else {
+                Zero(&utbuf, sizeof utbuf, char);
 #ifdef BIG_TIME
-           utbuf.actime = (Time_t)SvNVx(accessed);     /* time accessed */
-           utbuf.modtime = (Time_t)SvNVx(modified);    /* time modified */
+                utbuf.actime = (Time_t)SvNVx(accessed);  /* time accessed */
+                utbuf.modtime = (Time_t)SvNVx(modified); /* time modified */
 #else
-           utbuf.actime = (Time_t)SvIVx(accessed);     /* time accessed */
-           utbuf.modtime = (Time_t)SvIVx(modified);    /* time modified */
+                utbuf.actime = (Time_t)SvIVx(accessed);  /* time accessed */
+                utbuf.modtime = (Time_t)SvIVx(modified); /* time modified */
 #endif
-           APPLY_TAINT_PROPER();
+            }
+            APPLY_TAINT_PROPER();
            tot = sp - mark;
            while (++mark <= sp) {
                char *name = SvPVx(*mark, n_a);