X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=ef16b07906f19a2373d2c8d9cc66d37de3f3929e;hb=b2a156bd8e464af88881c77344280160fd844dcf;hp=f5f59a3898612983b7da8e86c1843970ca9a324f;hpb=35da51f7f2e09d38719c2d96d9f3eacd4f9f796a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doio.c b/doio.c
index f5f59a3..ef16b07 100644
--- a/doio.c
+++ b/doio.c
@@ -258,17 +258,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	    }
 	    mode[0] = 'w';
 	    writing = 1;
-#ifdef HAS_STRLCAT
             if (out_raw)
-                strlcat(mode, "b", PERL_MODE_MAX - 1);
+                my_strlcat(mode, "b", PERL_MODE_MAX - 1);
             else if (out_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX - 1); 
-#else
-	    if (out_raw)
-		strcat(mode, "b");
-	    else if (out_crlf)
-		strcat(mode, "t");
-#endif
+                my_strlcat(mode, "t", PERL_MODE_MAX - 1); 
 	    if (num_svs > 1) {
 		fp = PerlProc_popen_list(mode, num_svs, svp);
 	    }
@@ -296,17 +289,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	    }
 	    writing = 1;
 
-#ifdef HAS_STRLCAT
             if (out_raw)
-                strlcat(mode, "b", PERL_MODE_MAX - 1);
+                my_strlcat(mode, "b", PERL_MODE_MAX - 1);
             else if (out_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX - 1);
-#else
-	    if (out_raw)
-		strcat(mode, "b");
-	    else if (out_crlf)
-		strcat(mode, "t");
-#endif
+                my_strlcat(mode, "t", PERL_MODE_MAX - 1);
 	    if (*type == '&') {
 	      duplicity:
 		dodup = PERLIO_DUP_FD;
@@ -429,17 +415,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 		type++;
 	    } while (isSPACE(*type));
 	    mode[0] = 'r';
-#ifdef HAS_STRLCAT
             if (in_raw)
-                strlcat(mode, "b", PERL_MODE_MAX - 1);
+                my_strlcat(mode, "b", PERL_MODE_MAX - 1);
             else if (in_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX - 1);
-#else
-	    if (in_raw)
-		strcat(mode, "b");
-	    else if (in_crlf)
-		strcat(mode, "t");
-#endif
+                my_strlcat(mode, "t", PERL_MODE_MAX - 1);
 	    if (*type == '&') {
 		goto duplicity;
 	    }
@@ -490,17 +469,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 	    TAINT_PROPER("piped open");
 	    mode[0] = 'r';
 
-#ifdef HAS_STRLCAT
             if (in_raw)
-                strlcat(mode, "b", PERL_MODE_MAX - 1);
+                my_strlcat(mode, "b", PERL_MODE_MAX - 1);
             else if (in_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX - 1);
-#else
-	    if (in_raw)
-		strcat(mode, "b");
-	    else if (in_crlf)
-		strcat(mode, "t");
-#endif
+                my_strlcat(mode, "t", PERL_MODE_MAX - 1);
 
 	    if (num_svs > 1) {
 		fp = PerlProc_popen_list(mode,num_svs,svp);
@@ -528,17 +500,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
 		;
 	    mode[0] = 'r';
 
-#ifdef HAS_STRLCAT
             if (in_raw)
-                strlcat(mode, "b", PERL_MODE_MAX - 1);
+                my_strlcat(mode, "b", PERL_MODE_MAX - 1);
             else if (in_crlf)
-                strlcat(mode, "t", PERL_MODE_MAX - 1);
-#else
-	    if (in_raw)
-		strcat(mode, "b");
-	    else if (in_crlf)
-		strcat(mode, "t");
-#endif
+                my_strlcat(mode, "t", PERL_MODE_MAX - 1);
 
 	    if (*name == '-' && name[1] == '\0') {
 		fp = PerlIO_stdin();
@@ -1308,22 +1273,33 @@ Perl_my_stat(pTHX)
 	EXTEND(SP,1);
 	gv = cGVOP_gv;
       do_fstat:
+        if (gv == PL_defgv)
+            return PL_laststatval;
 	io = GvIO(gv);
-	if (io && IoIFP(io)) {
-	    PL_statgv = gv;
-	    sv_setpvn(PL_statname,"", 0);
-	    PL_laststype = OP_STAT;
-	    return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache));
-	}
-	else {
-	    if (gv == PL_defgv)
-		return PL_laststatval;
-	    if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
-		report_evil_fh(gv, io, PL_op->op_type);
-	    PL_statgv = NULL;
-	    sv_setpvn(PL_statname,"", 0);
-	    return (PL_laststatval = -1);
-	}
+        do_fstat_have_io:
+        PL_laststype = OP_STAT;
+        PL_statgv = gv;
+        sv_setpvn(PL_statname, "", 0);
+        if(io) {
+	    if (IoIFP(io)) {
+	        return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache));
+            } else if (IoDIRP(io)) {
+#ifdef HAS_DIRFD
+                return (PL_laststatval = PerlLIO_fstat(dirfd(IoDIRP(io)), &PL_statcache));
+#else
+                Perl_die(aTHX_ PL_no_func, "dirfd");
+                NORETURN_FUNCTION_END;
+#endif
+            } else {
+                if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+                    report_evil_fh(gv, io, PL_op->op_type);
+                return (PL_laststatval = -1);
+            }
+	} else {
+            if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+                report_evil_fh(gv, io, PL_op->op_type);
+            return (PL_laststatval = -1);
+        }
     }
     else if (PL_op->op_private & OPpFT_STACKED) {
 	return PL_laststatval;
@@ -1341,6 +1317,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;
@@ -1352,6 +1333,8 @@ Perl_my_stat(pTHX)
 	    Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
 	return PL_laststatval;
     }
+    /* Should we warn/croak here? Or do something smart/useful? */
+    return (PL_laststatval = -1);
 }
 
 
@@ -1396,6 +1379,19 @@ Perl_my_lstat(pTHX)
     return PL_laststatval;
 }
 
+static void
+S_exec_failed(pTHX_ const char *cmd, int fd, int do_report)
+{
+    const int e = errno;
+    if (ckWARN(WARN_EXEC))
+	Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
+		    cmd, Strerror(e));
+    if (do_report) {
+	PerlLIO_write(fd, (void*)&e, sizeof(int));
+	PerlLIO_close(fd);
+    }
+}
+
 bool
 Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
 	       int fd, int do_report)
@@ -1428,15 +1424,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
 	else
 	    PerlProc_execvp(PL_Argv[0],EXEC_ARGV_CAST(PL_Argv));
 	PERL_FPU_POST_EXEC
-	if (ckWARN(WARN_EXEC))
-	    Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
-		(really ? tmps : PL_Argv[0]), Strerror(errno));
-	if (do_report) {
-	    const int e = errno;
-
-	    PerlLIO_write(fd, (void*)&e, sizeof(int));
-	    PerlLIO_close(fd);
-	}
+ 	S_exec_failed(aTHX_ (really ? tmps : PL_Argv[0]), fd, do_report);
     }
     do_execfree();
 #endif
@@ -1464,10 +1452,9 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
     char *cmd;
 
     /* Make a copy so we can change it */
-    const int cmdlen = strlen(incmd);
-    Newx(cmd, cmdlen+1, char);
-    strncpy(cmd, incmd, cmdlen);
-    cmd[cmdlen] = 0;
+    const Size_t cmdlen = strlen(incmd) + 1;
+    Newx(cmd, cmdlen, char);
+    my_strlcpy(cmd, incmd, cmdlen);
 
     while (*cmd && isSPACE(*cmd))
 	cmd++;
@@ -1479,19 +1466,11 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
         char flags[PERL_FLAGS_MAX];
 	if (strnEQ(cmd,PL_cshname,PL_cshlen) &&
 	    strnEQ(cmd+PL_cshlen," -c",3)) {
-#ifdef HAS_STRLCPY
-          strlcpy(flags, "-c", PERL_FLAGS_MAX);
-#else
-	  strcpy(flags,"-c");
-#endif
+          my_strlcpy(flags, "-c", PERL_FLAGS_MAX);
 	  s = cmd+PL_cshlen+3;
 	  if (*s == 'f') {
 	      s++;
-#ifdef HAS_STRLCPY
-              strlcat(flags, "f", PERL_FLAGS_MAX - 2);
-#else
-	      strcat(flags,"f");
-#endif
+              my_strlcat(flags, "f", PERL_FLAGS_MAX - 2);
 	  }
 	  if (*s == ' ')
 	      s++;
@@ -1505,9 +1484,10 @@ 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);
 		  return FALSE;
 	      }
@@ -1553,8 +1533,9 @@ 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);
 	    return FALSE;
 	}
@@ -1582,14 +1563,7 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report)
 	    do_execfree();
 	    goto doshell;
 	}
-	if (ckWARN(WARN_EXEC))
-	    Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't exec \"%s\": %s",
-		PL_Argv[0], Strerror(errno));
-	if (do_report) {
-	    const int e = errno;
-	    PerlLIO_write(fd, (const void*)&e, sizeof(int));
-	    PerlLIO_close(fd);
-	}
+ 	S_exec_failed(aTHX_ PL_Argv[0], fd, do_report);
     }
     do_execfree();
     Safefree(cmd);
@@ -2280,7 +2254,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;
     }
@@ -2308,7 +2283,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp)
 	STRLEN len;
 
 	const char *mbuf = SvPV_const(mstr, len);
-	const I32 n = (len > msize) ? msize : len;
+	const I32 n = ((I32)len > msize) ? msize : (I32)len;
 	Copy(mbuf, shm + mpos, n, char);
 	if (n < msize)
 	    memzero(shm + mpos + n, msize - n);