X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=353e2a9182c1e2529ad79961d00e65bcbb72c8b4;hb=363c40c40eaf5d0cfd92f460a3f838c41f9756ad;hp=76ad3350d970085fff8c1b1f4d1faf8436303c66;hpb=6ec06612ae1fd94d8b029b09c7ab7efa1c33f2e4;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doio.c b/doio.c
index 76ad335..353e2a9 100644
--- a/doio.c
+++ b/doio.c
@@ -1,6 +1,7 @@
 /*    doio.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2003, 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.
@@ -178,7 +179,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 		 (ismodifying & (O_CREAT|appendtrunc)))
 		  TAINT_PROPER("sysopen");
 	}
-	mode[ix++] = '#'; /* Marker to openn to use numeric "sysopen" */
+	mode[ix++] = IoTYPE_NUMERIC; /* Marker to openn to use numeric "sysopen" */
 
 #if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
 	rawmode |= O_LARGEFILE;	/* Transparently largefiley. */
@@ -640,8 +641,16 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                 /* need to close fp without closing underlying fd */
                 int ofd = PerlIO_fileno(fp);
                 int dupfd = PerlLIO_dup(ofd);
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+		/* Assume if we have F_SETFD we have F_GETFD */
+                int coe = fcntl(ofd,F_GETFD);
+#endif
                 PerlIO_close(fp);
                 PerlLIO_dup2(dupfd,ofd);
+#if defined(HAS_FCNTL) && defined(F_SETFD)
+		/* The dup trick has lost close-on-exec on ofd */
+		fcntl(ofd,F_SETFD, coe);
+#endif
                 PerlLIO_close(dupfd);
 	    }
             else
@@ -665,8 +674,8 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	if (IoTYPE(io) == IoTYPE_SOCKET
 	    || (IoTYPE(io) == IoTYPE_WRONLY && fd >= 0 && S_ISCHR(PL_statbuf.st_mode)) ) {
 	    char *s = mode;
-	    if (*s == 'I' || *s == '#')
-	     s++;
+	    if (*s == IoTYPE_IMPLICIT || *s == IoTYPE_NUMERIC)
+	      s++;
 	    *s = 'w';
 	    if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,s,fd,0,0,NULL,0,svp))) {
 		PerlIO_close(fp);
@@ -717,6 +726,8 @@ Perl_nextargv(pTHX_ register GV *gv)
 #endif
     }
     PL_filemode = 0;
+    if (!GvAV(gv))
+        return Nullfp;
     while (av_len(GvAV(gv)) >= 0) {
 	STRLEN oldlen;
 	sv = av_shift(GvAV(gv));
@@ -1027,17 +1038,21 @@ Perl_do_eof(pTHX_ GV *gv)
 	report_evil_fh(gv, io, OP_phoney_OUTPUT_ONLY);
 
     while (IoIFP(io)) {
+        int saverrno;
 
         if (PerlIO_has_cntptr(IoIFP(io))) {	/* (the code works without this) */
 	    if (PerlIO_get_cnt(IoIFP(io)) > 0)	/* cheat a little, since */
 		return FALSE;			/* this is the most usual case */
         }
 
+	saverrno = errno; /* getc and ungetc can stomp on errno */
 	ch = PerlIO_getc(IoIFP(io));
 	if (ch != EOF) {
 	    (void)PerlIO_ungetc(IoIFP(io),ch);
+	    errno = saverrno;
 	    return FALSE;
 	}
+	errno = saverrno;
 
         if (PerlIO_has_cntptr(IoIFP(io)) && PerlIO_canset_cnt(IoIFP(io))) {
 	    if (PerlIO_get_cnt(IoIFP(io)) < -1)
@@ -1150,7 +1165,7 @@ fail_discipline:
 		if (!end)
 		    end = s+len;
 #ifndef PERLIO_LAYERS
-		Perl_croak(aTHX_ "Unknown discipline '%.*s'", end-s, s);
+		Perl_croak(aTHX_ "IO layers (like '%.*s') unavailable", end-s, s);
 #else
 		s = end;
 #endif
@@ -1321,7 +1336,7 @@ Perl_my_stat(pTHX)
     else {
 	SV* sv = POPs;
 	char *s;
-	STRLEN n_a;
+	STRLEN len;
 	PUTBACK;
 	if (SvTYPE(sv) == SVt_PVGV) {
 	    gv = (GV*)sv;
@@ -1332,9 +1347,10 @@ Perl_my_stat(pTHX)
 	    goto do_fstat;
 	}
 
-	s = SvPV(sv, n_a);
+	s = SvPV(sv, len);
 	PL_statgv = Nullgv;
-	sv_setpv(PL_statname, s);
+	sv_setpvn(PL_statname, s, len);
+	s = SvPVX(PL_statname);		/* s now NUL-terminated */
 	PL_laststype = OP_STAT;
 	PL_laststatval = PerlLIO_stat(s, &PL_statcache);
 	if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n'))
@@ -1379,11 +1395,13 @@ Perl_my_lstat(pTHX)
     return PL_laststatval;
 }
 
+#ifndef OS2
 bool
 Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp)
 {
     return do_aexec5(really, mark, sp, 0, 0);
 }
+#endif
 
 bool
 Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
@@ -1411,10 +1429,12 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
 	if ((!really && *PL_Argv[0] != '/') ||
 	    (really && *tmps != '/'))		/* will execvp use PATH? */
 	    TAINT_ENV();		/* testing IFS here is overkill, probably */
+	PERL_FPU_PRE_EXEC
 	if (really && *tmps)
 	    PerlProc_execvp(tmps,EXEC_ARGV_CAST(PL_Argv));
 	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));
@@ -1484,7 +1504,9 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
 		  *--s = '\0';
 	      if (s[-1] == '\'') {
 		  *--s = '\0';
+		  PERL_FPU_PRE_EXEC
 		  PerlProc_execl(PL_cshname,"csh", flags, ncmd, (char*)0);
+		  PERL_FPU_POST_EXEC
 		  *s = '\'';
 		  return FALSE;
 	      }
@@ -1527,7 +1549,9 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
 		}
 	    }
 	  doshell:
+	    PERL_FPU_PRE_EXEC
 	    PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char*)0);
+	    PERL_FPU_POST_EXEC
 	    return FALSE;
 	}
     }
@@ -1545,7 +1569,9 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report)
     }
     *a = Nullch;
     if (PL_Argv[0]) {
+	PERL_FPU_PRE_EXEC
 	PerlProc_execvp(PL_Argv[0],PL_Argv);
+	PERL_FPU_POST_EXEC
 	if (errno == ENOEXEC) {		/* for system V NIH syndrome */
 	    do_execfree();
 	    goto doshell;
@@ -1641,10 +1667,10 @@ nothing in the core.
 	if (mark == sp)
 	    break;
 	s = SvPVx(*++mark, n_a);
-	if (isUPPER(*s)) {
+	if (isALPHA(*s)) {
 	    if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
 		s += 3;
-	    if (!(val = whichsig(s)))
+	    if ((val = whichsig(s)) < 0)
 		Perl_croak(aTHX_ "Unrecognized signal name \"%s\"",s);
 	}
 	else