X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=8a12268474e3b39a2bd99acebdd393d7eb81a094;hb=5bdf71cc9217764029fb9a321295118de3bb8e72;hp=506470504e1d77b5f77e289f34fb8caf3352cbce;hpb=a45c7426c93f17067d1734c68cb400246e1db490;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doio.c b/doio.c
index 5064705..8a12268 100644
--- a/doio.c
+++ b/doio.c
@@ -9,10 +9,12 @@
  */
 
 /*
- * "Far below them they saw the white waters pour into a foaming bowl, and
- * then swirl darkly about a deep oval basin in the rocks, until they found
- * their way out again through a narrow gate, and flowed away, fuming and
- * chattering, into calmer and more level reaches."
+ *  Far below them they saw the white waters pour into a foaming bowl, and
+ *  then swirl darkly about a deep oval basin in the rocks, until they found
+ *  their way out again through a narrow gate, and flowed away, fuming and
+ *  chattering, into calmer and more level reaches.
+ *
+ *     [p.684 of _The Lord of the Rings_, IV/vi: "The Forbidden Pool"]
  */
 
 /* This file contains functions that do the actual I/O on behalf of ops.
@@ -624,7 +626,6 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                 Pid_t pid;
                 SV *sv;
 
-                LOCK_FDPID_MUTEX;
                 sv = *av_fetch(PL_fdpid,fd,TRUE);
                 SvUPGRADE(sv, SVt_IV);
                 pid = SvIVX(sv);
@@ -632,7 +633,6 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
                 sv = *av_fetch(PL_fdpid,savefd,TRUE);
                 SvUPGRADE(sv, SVt_IV);
                 SvIV_set(sv, pid);
-                UNLOCK_FDPID_MUTEX;
             }
 #endif
 
@@ -661,9 +661,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
     }
 #if defined(HAS_FCNTL) && defined(F_SETFD)
     if (fd >= 0) {
-	const int save_errno = errno;
+	dSAVE_ERRNO;
 	fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */
-	errno = save_errno;
+	RESTORE_ERRNO;
     }
 #endif
     IoIFP(io) = fp;
@@ -809,8 +809,7 @@ Perl_nextargv(pTHX_ register GV *gv)
 		    do_close(gv,FALSE);
 		    (void)PerlLIO_unlink(SvPVX_const(sv));
 		    (void)PerlLIO_rename(PL_oldname,SvPVX_const(sv));
-		    do_open(gv,(char*)SvPVX_const(sv),SvCUR(sv),PL_inplace!=0,
-			    O_RDONLY,0,NULL);
+		    do_open(gv,(char*)SvPVX_const(sv),SvCUR(sv),TRUE,O_RDONLY,0,NULL);
 #endif /* DOSISH */
 #else
 		    (void)UNLINK(SvPVX_const(sv));
@@ -842,18 +841,16 @@ Perl_nextargv(pTHX_ register GV *gv)
 #endif
 		}
 
-		sv_setpvn(sv,">",!PL_inplace);
-		sv_catpvn(sv,PL_oldname,oldlen);
+		sv_setpvn(sv,PL_oldname,oldlen);
 		SETERRNO(0,0);		/* in case sprintf set errno */
+		if (!Perl_do_openn(aTHX_ PL_argvoutgv, (char*)SvPVX_const(sv),
+				   SvCUR(sv), TRUE,
 #ifdef VMS
-		if (!do_open(PL_argvoutgv,(char*)SvPVX_const(sv),SvCUR(sv),
-			     PL_inplace!=0,O_WRONLY|O_CREAT|O_TRUNC,0,NULL))
+				   O_WRONLY|O_CREAT|O_TRUNC,0,
 #else
-		    if (!do_open(PL_argvoutgv,(char*)SvPVX_const(sv),SvCUR(sv),
-			     PL_inplace!=0,O_WRONLY|O_CREAT|OPEN_EXCL,0666,
-			     NULL))
+				   O_WRONLY|O_CREAT|OPEN_EXCL,0600,
 #endif
-		{
+				   NULL, NULL, 0)) {
 		    if (ckWARN_d(WARN_INPLACE))	
 		        Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't do inplace edit on %s: %s",
 		          PL_oldname, Strerror(errno) );
@@ -906,7 +903,7 @@ Perl_nextargv(pTHX_ register GV *gv)
 	if (io && (IoFLAGS(io) & IOf_ARGV)
 	    && PL_argvout_stack && AvFILLp(PL_argvout_stack) >= 0)
 	{
-	    GV * const oldout = (GV*)av_pop(PL_argvout_stack);
+	    GV * const oldout = MUTABLE_GV(av_pop(PL_argvout_stack));
 	    setdefout(oldout);
 	    SvREFCNT_dec(oldout);
 	    return NULL;
@@ -1012,14 +1009,14 @@ Perl_do_eof(pTHX_ GV *gv)
 
 	{
 	     /* getc and ungetc can stomp on errno */
-	    const int saverrno = errno;
+	    dSAVE_ERRNO;
 	    const int ch = PerlIO_getc(IoIFP(io));
 	    if (ch != EOF) {
 		(void)PerlIO_ungetc(IoIFP(io),ch);
-		errno = saverrno;
+		RESTORE_ERRNO;
 		return FALSE;
 	    }
-	    errno = saverrno;
+	    RESTORE_ERRNO;
 	}
 
         if (PerlIO_has_cntptr(IoIFP(io)) && PerlIO_canset_cnt(IoIFP(io))) {
@@ -1308,11 +1305,11 @@ Perl_my_stat(pTHX)
 	STRLEN len;
 	PUTBACK;
 	if (isGV_with_GP(sv)) {
-	    gv = (GV*)sv;
+	    gv = MUTABLE_GV(sv);
 	    goto do_fstat;
 	}
 	else if (SvROK(sv) && isGV_with_GP(SvRV(sv))) {
-	    gv = (GV*)SvRV(sv);
+	    gv = MUTABLE_GV(SvRV(sv));
 	    goto do_fstat;
 	}
         else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) {
@@ -1365,7 +1362,7 @@ Perl_my_lstat(pTHX)
     PUTBACK;
     if (SvROK(sv) && isGV_with_GP(SvRV(sv)) && ckWARN(WARN_IO)) {
 	Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle %s",
-		GvENAME((GV*) SvRV(sv)));
+		GvENAME((const GV *)SvRV(sv)));
 	return (PL_laststatval = -1);
     }
     file = SvPV_nolen_const(sv);
@@ -1396,7 +1393,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp,
 {
     dVAR;
     PERL_ARGS_ASSERT_DO_AEXEC5;
-#if defined(MACOS_TRADITIONAL) || defined(__SYMBIAN32__) || defined(__LIBCATAMOUNT__)
+#if defined(__SYMBIAN32__) || defined(__LIBCATAMOUNT__)
     Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
 #else
     if (sp > mark) {
@@ -1625,7 +1622,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
 	    while (++mark <= sp) {
                 GV* gv;
                 if (isGV_with_GP(*mark)) {
-                    gv = (GV*)*mark;
+                    gv = MUTABLE_GV(*mark);
 		do_fchmod:
 		    if (GvIO(gv) && IoIFP(GvIOp(gv))) {
 #ifdef HAS_FCHMOD
@@ -1641,7 +1638,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
 		    }
 		}
 		else if (SvROK(*mark) && isGV_with_GP(SvRV(*mark))) {
-		    gv = (GV*)SvRV(*mark);
+		    gv = MUTABLE_GV(SvRV(*mark));
 		    goto do_fchmod;
 		}
 		else {
@@ -1665,7 +1662,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
 	    while (++mark <= sp) {
                 GV* gv;
                 if (isGV_with_GP(*mark)) {
-                    gv = (GV*)*mark;
+                    gv = MUTABLE_GV(*mark);
 		do_fchown:
 		    if (GvIO(gv) && IoIFP(GvIOp(gv))) {
 #ifdef HAS_FCHOWN
@@ -1681,7 +1678,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp)
 		    }
 		}
 		else if (SvROK(*mark) && isGV_with_GP(SvRV(*mark))) {
-		    gv = (GV*)SvRV(*mark);
+		    gv = MUTABLE_GV(SvRV(*mark));
 		    goto do_fchown;
 		}
 		else {
@@ -1837,7 +1834,7 @@ nothing in the core.
 	    while (++mark <= sp) {
                 GV* gv;
                 if (isGV_with_GP(*mark)) {
-                    gv = (GV*)*mark;
+                    gv = MUTABLE_GV(*mark);
 		do_futimes:
 		    if (GvIO(gv) && IoIFP(GvIOp(gv))) {
 #ifdef HAS_FUTIMES
@@ -1854,7 +1851,7 @@ nothing in the core.
 		    }
 		}
 		else if (SvROK(*mark) && isGV_with_GP(SvRV(*mark))) {
-		    gv = (GV*)SvRV(*mark);
+		    gv = MUTABLE_GV(SvRV(*mark));
 		    goto do_futimes;
 		}
 		else {
@@ -1941,13 +1938,9 @@ Perl_cando(pTHX_ Mode_t mode, bool effective, register const Stat_t *statbufp)
 }
 #endif /* ! VMS */
 
-bool
-Perl_ingroup(pTHX_ Gid_t testgid, bool effective)
+static bool
+S_ingroup(pTHX_ Gid_t testgid, bool effective)
 {
-#ifdef MACOS_TRADITIONAL
-    /* This is simply not correct for AppleShare, but fix it yerself. */
-    return TRUE;
-#else
     dVAR;
     if (testgid == (effective ? PL_egid : PL_gid))
 	return TRUE;
@@ -1972,7 +1965,6 @@ Perl_ingroup(pTHX_ Gid_t testgid, bool effective)
 #else
     return FALSE;
 #endif
-#endif
 }
 
 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
@@ -1982,7 +1974,7 @@ Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp)
 {
     dVAR;
     const key_t key = (key_t)SvNVx(*++mark);
-    const I32 n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark);
+    SV *nsv = optype == OP_MSGGET ? NULL : *++mark;
     const I32 flags = SvIVx(*++mark);
 
     PERL_ARGS_ASSERT_DO_IPCGET;
@@ -1997,11 +1989,11 @@ Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp)
 #endif
 #ifdef HAS_SEM
     case OP_SEMGET:
-	return semget(key, n, flags);
+	return semget(key, (int) SvIV(nsv), flags);
 #endif
 #ifdef HAS_SHM
     case OP_SHMGET:
-	return shmget(key, n, flags);
+	return shmget(key, (size_t) SvUV(nsv), flags);
 #endif
 #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
     default:
@@ -2353,11 +2345,6 @@ Perl_vms_start_glob
     fp = Perl_vms_start_glob(aTHX_ tmpglob, io);
 
 #else /* !VMS */
-#ifdef MACOS_TRADITIONAL
-    sv_setpv(tmpcmd, "glob ");
-    sv_catsv(tmpcmd, tmpglob);
-    sv_catpv(tmpcmd, " |");
-#else
 #ifdef DOSISH
 #ifdef OS2
     sv_setpv(tmpcmd, "for a in ");
@@ -2389,7 +2376,6 @@ Perl_vms_start_glob
 #endif
 #endif /* !CSH */
 #endif /* !DOSISH */
-#endif /* MACOS_TRADITIONAL */
     (void)do_open(PL_last_in_gv, (char*)SvPVX_const(tmpcmd), SvCUR(tmpcmd),
 		  FALSE, O_RDONLY, 0, NULL);
     fp = IoIFP(io);