From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Sat, 10 May 2003 15:59:26 +0000 (+0000)
Subject: Fix for bugs 21717 and 22140.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6caa5a9cfe39f91bc44bba937a0b491f754fe9cd;p=p5sagit%2Fp5-mst-13.2.git

Fix for bugs 21717 and 22140.
Win32's lseek claims to have succeeded in pipes etc. Which confuses :perlio
and derived layers. So have :unix's "pushed" method stat() the fd and
cache non S_ISREG nature. Have Unix_seek fail if fd is NOT S_ISREG to match
UNIX behaviour.

p4raw-id: //depot/perlio@19475
---

diff --git a/perlio.c b/perlio.c
index 657aeef..e50f504 100644
--- a/perlio.c
+++ b/perlio.c
@@ -2334,6 +2334,14 @@ PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
     IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
     PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
+#if defined(WIN32)
+    struct stat  st;
+    if (fstat(s->fd, &st) == 0) {
+	if (!S_ISREG(st.st_mode)) {
+    	    PerlIOBase(f)->flags |= PERLIO_F_NOTREG;
+	}
+    }
+#endif
     if (*PerlIONext(f)) {
 	/* We never call down so do any pending stuff now */
 	PerlIO_flush(PerlIONext(f));
@@ -2346,6 +2354,7 @@ PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 	s->oflags = mode ? PerlIOUnix_oflags(mode) : -1;
     }
     PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+
     return code;
 }
 
@@ -2460,10 +2469,23 @@ PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 IV
 PerlIOUnix_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
-    Off_t new =
-	PerlLIO_lseek(PerlIOSelf(f, PerlIOUnix)->fd, offset, whence);
+    int fd = PerlIOSelf(f, PerlIOUnix)->fd;
+    Off_t new;
+    if (PerlIOBase(f)->flags & PERLIO_F_NOTREG) {
+#ifdef  ESPIPE
+	SETERRNO(ESPIPE, LIB_INVARG);
+#else
+	SETERRNO(EINVAL, LIB_INVARG);
+#endif
+	return -1;
+    } 
+    new  = PerlLIO_lseek(fd, offset, whence);
+    if (new == (Off_t) - 1)
+     {
+      return -1;
+     }
     PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
-    return (new == (Off_t) - 1) ? -1 : 0;
+    return  0;
 }
 
 Off_t
diff --git a/perliol.h b/perliol.h
index fa399e6..47fe6fc 100644
--- a/perliol.h
+++ b/perliol.h
@@ -88,6 +88,7 @@ struct _PerlIO {
 #define PERLIO_F_OPEN		0x00200000
 #define PERLIO_F_FASTGETS	0x00400000
 #define PERLIO_F_TTY		0x00800000
+#define PERLIO_F_NOTREG         0x01000000   
 
 #define PerlIOBase(f)      (*(f))
 #define PerlIOSelf(f,type) ((type *)PerlIOBase(f))