This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Bump $Win32API::File::VERSION for change #30409
[perl5.git] / doio.c
diff --git a/doio.c b/doio.c
index a24d572..1f1d2a2 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, 2004, 2005, 2006, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 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.
@@ -710,10 +710,9 @@ Perl_nextargv(pTHX_ register GV *gv)
     if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) {
        IoFLAGS(io) &= ~IOf_START;
        if (PL_inplace) {
-           if (!PL_argvout_stack)
-               PL_argvout_stack = newAV();
            assert(PL_defoutgv);
-           av_push(PL_argvout_stack, SvREFCNT_inc_simple_NN(PL_defoutgv));
+           Perl_av_create_and_push(aTHX_ &PL_argvout_stack,
+                                   SvREFCNT_inc_simple_NN(PL_defoutgv));
        }
     }
     if (PL_filemode & (S_ISUID|S_ISGID)) {
@@ -787,7 +786,7 @@ Perl_nextargv(pTHX_ register GV *gv)
                        if (ckWARN_d(WARN_INPLACE))     
                            Perl_warner(aTHX_ packWARN(WARN_INPLACE),
                              "Can't do inplace edit: %"SVf" would not be unique",
-                             (void*)sv);
+                             SVfARG(sv));
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -798,7 +797,7 @@ Perl_nextargv(pTHX_ register GV *gv)
                        if (ckWARN_d(WARN_INPLACE))     
                            Perl_warner(aTHX_ packWARN(WARN_INPLACE),
                              "Can't rename %s to %"SVf": %s, skipping file",
-                             PL_oldname, (void*)sv, Strerror(errno));
+                             PL_oldname, SVfARG(sv), Strerror(errno));
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -815,7 +814,7 @@ Perl_nextargv(pTHX_ register GV *gv)
                        if (ckWARN_d(WARN_INPLACE))     
                            Perl_warner(aTHX_ packWARN(WARN_INPLACE),
                              "Can't rename %s to %"SVf": %s, skipping file",
-                             PL_oldname, (void*)sv, Strerror(errno) );
+                             PL_oldname, SVfARG(sv), Strerror(errno) );
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -1197,32 +1196,24 @@ bool
 Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
 {
     dVAR;
-    register const char *tmps;
-    STRLEN len;
-    U8 *tmpbuf = NULL;
-    bool happy = TRUE;
-
     /* assuming fp is checked earlier */
     if (!sv)
        return TRUE;
-    switch (SvTYPE(sv)) {
-    case SVt_NULL:
-       if (ckWARN(WARN_UNINITIALIZED))
-           report_uninit(sv);
-       return TRUE;
-    case SVt_IV:
-       if (SvIOK(sv)) {
-           assert(!SvGMAGICAL(sv));
-           if (SvIsUV(sv))
-               PerlIO_printf(fp, "%"UVuf, (UV)SvUVX(sv));
-           else
-               PerlIO_printf(fp, "%"IVdf, (IV)SvIVX(sv));
-           return !PerlIO_error(fp);
-       }
-       /* FALL THROUGH */
-    default:
+    if (SvTYPE(sv) == SVt_IV && SvIOK(sv)) {
+       assert(!SvGMAGICAL(sv));
+       if (SvIsUV(sv))
+           PerlIO_printf(fp, "%"UVuf, (UV)SvUVX(sv));
+       else
+           PerlIO_printf(fp, "%"IVdf, (IV)SvIVX(sv));
+       return !PerlIO_error(fp);
+    }
+    else {
+       STRLEN len;
        /* Do this first to trigger any overloading.  */
-       tmps = SvPV_const(sv, len);
+       const char *tmps = SvPV_const(sv, len);
+       U8 *tmpbuf = NULL;
+       bool happy = TRUE;
+
        if (PerlIO_isutf8(fp)) {
            if (!SvUTF8(sv)) {
                /* We don't modify the original scalar.  */
@@ -1247,18 +1238,17 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp)
                }
            }
        }
-       break;
+       /* To detect whether the process is about to overstep its
+        * filesize limit we would need getrlimit().  We could then
+        * also transparently raise the limit with setrlimit() --
+        * but only until the system hard limit/the filesystem limit,
+        * at which we would get EPERM.  Note that when using buffered
+        * io the write failure can be delayed until the flush/close. --jhi */
+       if (len && (PerlIO_write(fp,tmps,len) == 0))
+           happy = FALSE;
+       Safefree(tmpbuf);
+       return happy ? !PerlIO_error(fp) : FALSE;
     }
-    /* To detect whether the process is about to overstep its
-     * filesize limit we would need getrlimit().  We could then
-     * also transparently raise the limit with setrlimit() --
-     * but only until the system hard limit/the filesystem limit,
-     * at which we would get EPERM.  Note that when using buffered
-     * io the write failure can be delayed until the flush/close. --jhi */
-    if (len && (PerlIO_write(fp,tmps,len) == 0))
-       happy = FALSE;
-    Safefree(tmpbuf);
-    return happy ? !PerlIO_error(fp) : FALSE;
 }
 
 I32