X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=e1acc67c0ff087ec7aaea7cdb4806989fa3529f3;hb=63575281672bbbaaf04505eb965051807623f028;hp=809459feb92c9c95577205265c8c1e714b915d00;hpb=027aa12decdb9c925aa7dcd0b4307c73844261d0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doio.c b/doio.c
index 809459f..e1acc67 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,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
@@ -1276,6 +1266,7 @@ Perl_my_stat(pTHX)
         if (gv == PL_defgv)
             return PL_laststatval;
 	io = GvIO(gv);
+        do_fstat_have_io:
         PL_laststype = OP_STAT;
         PL_statgv = gv;
         sv_setpvn(PL_statname, "", 0);
@@ -1287,6 +1278,12 @@ Perl_my_stat(pTHX)
                 return (PL_laststatval = PerlLIO_fstat(dirfd(IoDIRP(io)), &PL_statcache));
 #else
                 Perl_die(aTHX_ PL_no_func, "dirfd");
+		/* NOT REACHED */
+		return 0;
+		/* Can't use NORETURN_FUNCTION_END because Perl_die is not
+		 *     __attribute__noreturn__
+		 * Can't use DIE because that does not return an integer
+		 */
 #endif
             } else {
                 if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
@@ -1315,6 +1312,11 @@ Perl_my_stat(pTHX)
 	    gv = (GV*)SvRV(sv);
 	    goto do_fstat;
 	}
+        else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
+            io = (IO*)SvRV(sv);
+	    gv = NULL;
+            goto do_fstat_have_io;
+        }
 
 	s = SvPV_const(sv, len);
 	PL_statgv = NULL;
@@ -1440,11 +1442,13 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
     dVAR;
     register char **a;
     register char *s;
+    char *buf;
     char *cmd;
 
     /* Make a copy so we can change it */
     const Size_t cmdlen = strlen(incmd) + 1;
-    Newx(cmd, cmdlen, char);
+    Newx(buf, cmdlen, char);
+    cmd = buf;
     my_strlcpy(cmd, incmd, cmdlen);
 
     while (*cmd && isSPACE(*cmd))
@@ -1475,11 +1479,11 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 	      if (s[-1] == '\'') {
 		  *--s = '\0';
 		  PERL_FPU_PRE_EXEC
-		  PerlProc_execl(PL_cshname, "csh", flags, ncmd, NULL);
+		  PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL);
 		  PERL_FPU_POST_EXEC
 		  *s = '\'';
  		  S_exec_failed(aTHX_ PL_cshname, fd, do_report);
-		  Safefree(cmd);
+		  Safefree(buf);
 		  return FALSE;
 	      }
 	  }
@@ -1524,10 +1528,10 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 	    }
 	  doshell:
 	    PERL_FPU_PRE_EXEC
-	    PerlProc_execl(PL_sh_path, "sh", "-c", cmd, NULL);
+	    PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL);
 	    PERL_FPU_POST_EXEC
  	    S_exec_failed(aTHX_ PL_sh_path, fd, do_report);
-	    Safefree(cmd);
+	    Safefree(buf);
 	    return FALSE;
 	}
     }
@@ -1557,7 +1561,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
  	S_exec_failed(aTHX_ PL_Argv[0], fd, do_report);
     }
     do_execfree();
-    Safefree(cmd);
+    Safefree(buf);
     return FALSE;
 }
 
@@ -1828,7 +1832,8 @@ nothing in the core.
 		    if (GvIO(gv) && IoIFP(GvIOp(gv))) {
 #ifdef HAS_FUTIMES
 			APPLY_TAINT_PROPER();
-			if (futimes(PerlIO_fileno(IoIFP(GvIOn(gv))), utbufp))
+			if (futimes(PerlIO_fileno(IoIFP(GvIOn(gv))),
+                            (struct timeval *) utbufp))
 			    tot--;
 #else
 			Perl_die(aTHX_ PL_no_func, "futimes");
@@ -1846,7 +1851,7 @@ nothing in the core.
 		    const char * const name = SvPV_nolen_const(*mark);
 		    APPLY_TAINT_PROPER();
 #ifdef HAS_FUTIMES
-		    if (utimes(name, utbufp))
+		    if (utimes(name, (struct timeval *)utbufp))
 #else
 		    if (PerlLIO_utime(name, utbufp))
 #endif
@@ -2245,7 +2250,8 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
     SETERRNO(0,0);
     if (shmctl(id, IPC_STAT, &shmds) == -1)
 	return -1;
-    if (mpos < 0 || msize < 0 || (size_t)mpos + msize > shmds.shm_segsz) {
+    if (mpos < 0 || msize < 0
+	|| (size_t)mpos + msize > (size_t)shmds.shm_segsz) {
 	SETERRNO(EFAULT,SS_ACCVIO);		/* can't do as caller requested */
 	return -1;
     }