X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=00e2e758859d919a5b2ef371caf7cc9c6e3769e1;hb=c578f5e04970af2516f26d023e8797da5451c90c;hp=271de285fa992599f115810947b0a2173ea133c6;hpb=acce7d4e04d89207299003c3e80c69d50bc82069;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doio.c b/doio.c
index 271de28..00e2e75 100644
--- a/doio.c
+++ b/doio.c
@@ -34,7 +34,7 @@
 #endif
 
 #ifdef I_UTIME
-#  ifdef WIN32
+#  ifdef _MSC_VER
 #    include <sys/utime.h>
 #  else
 #    include <utime.h>
@@ -66,6 +66,15 @@
 # endif
 #endif
 
+/* Put this after #includes because <unistd.h> defines _XOPEN_*. */
+#ifndef Sock_size_t
+#  if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) || defined(__GLIBC__)
+#    define Sock_size_t Size_t
+#  else
+#    define Sock_size_t int
+#  endif
+#endif
+
 bool
 do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp)
 GV *gv;
@@ -288,9 +297,10 @@ PerlIO *supplied_fp;
 	    !statbuf.st_mode
 #endif
 	) {
-	    int buflen = sizeof tokenbuf;
-	    if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0
-		|| errno != ENOTSOCK)
+	    Sock_size_t buflen = sizeof tokenbuf;
+	    if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf,
+			    &buflen) >= 0
+		  || errno != ENOTSOCK)
 		IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
 				/* but some return 0 for streams too, sigh */
 	}
@@ -471,7 +481,10 @@ register GV *gv;
 #ifdef HAS_FCHMOD
 		(void)fchmod(lastfd,filemode);
 #else
+#  if !(defined(WIN32) && defined(__BORLANDC__))
+		/* Borland runtime creates a readonly file! */
 		(void)chmod(oldname,filemode);
+#  endif
 #endif
 		if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) {
 #ifdef HAS_FCHOWN
@@ -650,22 +663,15 @@ do_tell(gv)
 GV *gv;
 {
     register IO *io;
+    register PerlIO *fp;
 
-    if (!gv)
-	goto phooey;
-
-    io = GvIO(gv);
-    if (!io || !IoIFP(io))
-	goto phooey;
-
+    if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) {
 #ifdef ULTRIX_STDIO_BOTCH
-    if (PerlIO_eof(IoIFP(io)))
-	(void)PerlIO_seek (IoIFP(io), 0L, 2);		/* ultrix 1.2 workaround */
+	if (PerlIO_eof(fp))
+	    (void)PerlIO_seek(fp, 0L, 2);	/* ultrix 1.2 workaround */
 #endif
-
-    return PerlIO_tell(IoIFP(io));
-
-phooey:
+	return PerlIO_tell(fp);
+    }
     if (dowarn)
 	warn("tell() on unopened file");
     SETERRNO(EBADF,RMS$_IFI);
@@ -679,28 +685,38 @@ long pos;
 int whence;
 {
     register IO *io;
+    register PerlIO *fp;
 
-    if (!gv)
-	goto nuts;
-
-    io = GvIO(gv);
-    if (!io || !IoIFP(io))
-	goto nuts;
-
+    if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) {
 #ifdef ULTRIX_STDIO_BOTCH
-    if (PerlIO_eof(IoIFP(io)))
-	(void)PerlIO_seek (IoIFP(io), 0L, 2);		/* ultrix 1.2 workaround */
+	if (PerlIO_eof(fp))
+	    (void)PerlIO_seek(fp, 0L, 2);	/* ultrix 1.2 workaround */
 #endif
-
-    return PerlIO_seek(IoIFP(io), pos, whence) >= 0;
-
-nuts:
+	return PerlIO_seek(fp, pos, whence) >= 0;
+    }
     if (dowarn)
 	warn("seek() on unopened file");
     SETERRNO(EBADF,RMS$_IFI);
     return FALSE;
 }
 
+long
+do_sysseek(gv, pos, whence)
+GV *gv;
+long pos;
+int whence;
+{
+    register IO *io;
+    register PerlIO *fp;
+
+    if (gv && (io = GvIO(gv)) && (fp = IoIFP(io)))
+	return lseek(PerlIO_fileno(fp), pos, whence);
+    if (dowarn)
+	warn("sysseek() on unopened file");
+    SETERRNO(EBADF,RMS$_IFI);
+    return -1L;
+}
+
 #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
 	/* code courtesy of William Kucharski */
 #define HAS_CHSIZE
@@ -709,7 +725,6 @@ I32 my_chsize(fd, length)
 I32 fd;			/* file descriptor */
 Off_t length;		/* length to set file to */
 {
-    extern long lseek();
     struct flock fl;
     struct stat filebuf;
 
@@ -927,7 +942,7 @@ do_execfree()
     }
 }
 
-#ifndef OS2
+#if !defined(OS2) && !defined(WIN32)
 
 bool
 do_exec(cmd)
@@ -1018,7 +1033,7 @@ char *cmd;
     return FALSE;
 }
 
-#endif /* OS2 */
+#endif /* OS2 || WIN32 */
 
 I32
 apply(type,mark,sp)
@@ -1318,6 +1333,9 @@ SV **sp;
     char *a;
     I32 id, n, cmd, infosize, getinfo;
     I32 ret = -1;
+#ifdef __linux__	/* XXX Need metaconfig test */
+    union semun unsemds;
+#endif
 
     id = SvIVx(*++mark);
     n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
@@ -1347,7 +1365,21 @@ SV **sp;
 	else if (cmd == GETALL || cmd == SETALL)
 	{
 	    struct semid_ds semds;
+#ifdef __linux__	/* XXX Need metaconfig test */
+/* linux (and Solaris2?) uses :
+   int semctl (int semid, int semnum, int cmd, union semun arg)
+       union semun {
+            int val;
+            struct semid_ds *buf;
+            ushort *array;
+       };
+*/
+            union semun semun;
+            semun.buf = &semds;
+	    if (semctl(id, 0, IPC_STAT, semun) == -1)
+#else
 	    if (semctl(id, 0, IPC_STAT, &semds) == -1)
+#endif
 		return -1;
 	    getinfo = (cmd == GETALL);
 	    infosize = semds.sem_nsems * sizeof(short);
@@ -1393,7 +1425,12 @@ SV **sp;
 #endif
 #ifdef HAS_SEM
     case OP_SEMCTL:
+#ifdef __linux__	/* XXX Need metaconfig test */
+        unsemds.buf = (struct semid_ds *)a;
+	ret = semctl(id, n, cmd, unsemds);
+#else
 	ret = semctl(id, n, cmd, (struct semid_ds *)a);
+#endif
 	break;
 #endif
 #ifdef HAS_SHM