X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f46fa3876d9373760a3cd5dd806719154ff55bcb..7aa88b299de9a4db2fd7199877a2fd354ba20d83:/doio.c

diff --git a/doio.c b/doio.c
index 88afb1d..1f1d2a2 100644
--- 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",
-			      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, sv, Strerror(errno) );
+			      PL_oldname, SVfARG(sv), Strerror(errno) );
 			do_close(gv,FALSE);
 			continue;
 		    }
@@ -1197,42 +1196,29 @@ 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)) {
-		const STRLEN origlen = len;
 		/* We don't modify the original scalar.  */
 		tmpbuf = bytes_to_utf8((const U8*) tmps, &len);
 		tmps = (char *) tmpbuf;
-		if (ckWARN(WARN_UTF8) && len != origlen) {
-		    Perl_warner(aTHX_ packWARN(WARN_UTF8),
-				"Variable length character upgraded in print");
-		}
 	    }
 	}
 	else if (DO_UTF8(sv)) {
@@ -1252,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