This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
$#a>>=1 relies on malloc wrap to avoid the segfault, so need to
[perl5.git] / doio.c
diff --git a/doio.c b/doio.c
index f0b036a..70b3535 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, 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.
  * 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"
@@ -723,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;
@@ -1170,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
            }
@@ -1268,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)) {