Change PerlIO_(get|set)pos to take SV *

Should fix, OS/2, VMS, (sfio??)

p4raw-id: //depot/perlio@8025

6 files changed, 93 insertions, 54 deletions

diff --git a/ext/IO/IO.xs b/ext/IO/IO.xs
index 6da48dca15..13b198cc71 100644
--- a/ext/IO/IO.xs
+++ b/ext/IO/IO.xs
@@ -59,9 +59,9 @@ io_blocking(InputStream f, int block)
     if (RETVAL >= 0) {
 	int mode = RETVAL;
 #ifdef O_NONBLOCK
-	/* POSIX style */ 
+	/* POSIX style */
 #if defined(O_NDELAY) && O_NDELAY != O_NONBLOCK
-	/* Ooops has O_NDELAY too - make sure we don't 
+	/* Ooops has O_NDELAY too - make sure we don't
 	 * get SysV behaviour by mistake. */
 
 	/* E.g. In UNICOS and UNICOS/mk a F_GETFL returns an O_NDELAY
@@ -86,7 +86,7 @@ io_blocking(InputStream f, int block)
               }
 	}
 #else
-	/* Standard POSIX */ 
+	/* Standard POSIX */
 	RETVAL = RETVAL & O_NONBLOCK ? 0 : 1;
 
 	if ((block == 0) && !(mode & O_NONBLOCK)) {
@@ -103,11 +103,11 @@ io_blocking(InputStream f, int block)
 	    if(ret < 0)
 		RETVAL = ret;
 	 }
-#endif 
+#endif
 #else
 	/* Not POSIX - better have O_NDELAY or we can't cope.
 	 * for BSD-ish machines this is an acceptable alternative
-	 * for SysV we can't tell "would block" from EOF but that is 
+	 * for SysV we can't tell "would block" from EOF but that is
 	 * the way SysV is...
 	 */
 	RETVAL = RETVAL & O_NDELAY ? 0 : 1;
@@ -141,18 +141,18 @@ fgetpos(handle)
 	InputStream	handle
     CODE:
 	if (handle) {
-	    Fpos_t pos;
-	    if (
 #ifdef PerlIO
-		PerlIO_getpos(handle, &pos)
+	    ST(0) = sv_2mortal(newSV(0));
+	    if (PerlIO_getpos(handle, ST(0)) != 0) {
+		ST(0) = &PL_sv_undef;
+	    }
 #else
-		fgetpos(handle, &pos)
-#endif
-		) {
+	    if (fgetpos(handle, &pos)) {
 		ST(0) = &PL_sv_undef;
 	    } else {
 		ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
 	    }
+#endif
 	}
 	else {
 	    ST(0) = &PL_sv_undef;
@@ -164,14 +164,21 @@ fsetpos(handle, pos)
 	InputStream	handle
 	SV *		pos
     CODE:
-        char *p;
-	STRLEN len;
-	if (handle && (p = SvPV(pos,len)) && len == sizeof(Fpos_t))
+	if (handle) {
 #ifdef PerlIO
-	    RETVAL = PerlIO_setpos(handle, (Fpos_t*)p);
+	    RETVAL = PerlIO_setpos(handle, pos);
 #else
-	    RETVAL = fsetpos(handle, (Fpos_t*)p);
+	    char *p;
+	    STRLEN len;
+	    if ((p = SvPV(pos,len)) && len == sizeof(Fpos_t)) {
+		RETVAL = fsetpos(handle, (Fpos_t*)p);
+	    }
+	    else {
+		RETVAL = -1;
+		errno = EINVAL;
+	    }
 #endif
+	}
 	else {
 	    RETVAL = -1;
 	    errno = EINVAL;
@@ -207,7 +214,7 @@ new_tmpfile(packname = "IO::File")
 
 MODULE = IO	PACKAGE = IO::Poll
 
-void   
+void
 _poll(timeout,...)
 	int timeout;
 PPCODE:
diff --git a/fakesdio.h b/fakesdio.h
index 374087f5a8..479123242f 100644
--- a/fakesdio.h
+++ b/fakesdio.h
@@ -71,9 +71,7 @@
 #define fread(b,s,c,f)		_CANNOT fread
 #define fwrite(b,s,c,f)		_CANNOT fwrite
 #endif
-#define fgetpos(f,p)		PerlIO_getpos(f,p)
 #define fseek(f,o,w)		PerlIO_seek(f,o,w)
-#define fsetpos(f,p)		PerlIO_setpos(f,p)
 #define ftell(f)		PerlIO_tell(f)
 #define rewind(f)		PerlIO_rewind(f)
 #define clearerr(f)		PerlIO_clearerr(f)
@@ -84,6 +82,9 @@
 #define popen(c,m)		my_popen(c,m)
 #define pclose(f)		my_pclose(f)
 
+#define fsetpos(f,p)		_CANNOT _fsetpos_
+#define fgetpos(f,p)		_CANNOT _fgetpos_
+
 #define __filbuf(f)		_CANNOT __filbuf_
 #define _filbuf(f)		_CANNOT _filbuf_
 #define __flsbuf(c,f)		_CANNOT __flsbuf_
diff --git a/perlapi.c b/perlapi.c
index 4f3497e4fd..e2df18e1ff 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -3227,6 +3227,13 @@ Perl_sv_unref(pTHXo_ SV* sv)
     ((CPerlObj*)pPerl)->Perl_sv_unref(sv);
 }
 
+#undef  Perl_sv_unref_flags
+void
+Perl_sv_unref_flags(pTHXo_ SV* sv, U32 flags)
+{
+    ((CPerlObj*)pPerl)->Perl_sv_unref_flags(sv, flags);
+}
+
 #undef  Perl_sv_untaint
 void
 Perl_sv_untaint(pTHXo_ SV* sv)
@@ -3868,6 +3875,13 @@ Perl_sv_force_normal(pTHXo_ SV *sv)
     ((CPerlObj*)pPerl)->Perl_sv_force_normal(sv);
 }
 
+#undef  Perl_sv_force_normal_flags
+void
+Perl_sv_force_normal_flags(pTHXo_ SV *sv, U32 flags)
+{
+    ((CPerlObj*)pPerl)->Perl_sv_force_normal_flags(sv, flags);
+}
+
 #undef  Perl_tmps_grow
 void
 Perl_tmps_grow(pTHXo_ I32 n)
diff --git a/perlio.c b/perlio.c
index a0856afbbb..874dece319 100644
--- a/perlio.c
+++ b/perlio.c
@@ -239,7 +239,7 @@ PerlIO_allocate(pTHX)
  if (!f)
   {
    return NULL;
-  } 
+  }
  *last = f;
  return f+1;
 }
@@ -318,7 +318,7 @@ PerlIO_find_layer(const char *name, STRLEN len)
  dTHX;
  SV **svp;
  SV *sv;
- if (len <= 0)
+ if ((SSize_t) len <= 0)
   len = strlen(name);
  svp  = hv_fetch(PerlIO_layer_hv,name,len,0);
  if (svp && (sv = *svp) && SvROK(sv))
@@ -643,7 +643,7 @@ PerlIO_fdupopen(pTHX_ PerlIO *f)
    Off_t posn = PerlIO_tell(f);
    PerlIO_seek(new,posn,SEEK_SET);
   }
- return new; 
+ return new;
 }
 
 #undef PerlIO_close
@@ -932,7 +932,7 @@ PerlIO_modestr(PerlIO *f,char *buf)
     {
      *s++ = '+';
     }
-  } 
+  }
  else if (flags & PERLIO_F_CANREAD)
   {
    *s++ = 'r';
@@ -1298,6 +1298,7 @@ Off_t
 PerlIOUnix_tell(PerlIO *f)
 {
  dTHX;
+ Off_t posn = PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR);
  return PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR);
 }
 
@@ -1367,20 +1368,19 @@ PerlIOStdio_fileno(PerlIO *f)
  return PerlSIO_fileno(PerlIOSelf(f,PerlIOStdio)->stdio);
 }
 
-const char *
+char *
 PerlIOStdio_mode(const char *mode,char *tmode)
 {
- const char *ret = mode;
+ char *ret = tmode;
+ while (*mode)
+  {
+   *tmode++ = *mode++;
+  }
  if (O_BINARY != O_TEXT)
   {
-   ret = (const char *) tmode;
-   while (*mode)
-    {
-     *tmode++ = *mode++;
-    }
    *tmode++ = 'b';
-   *tmode = '\0';
   }
+ *tmode = '\0';
  return ret;
 }
 
@@ -3148,47 +3148,70 @@ PerlIO_tmpfile(void)
 #ifndef HAS_FSETPOS
 #undef PerlIO_setpos
 int
-PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
+PerlIO_setpos(PerlIO *f, SV *pos)
 {
- return PerlIO_seek(f,*pos,0);
+ dTHX;
+ if (SvOK(pos))
+  {
+   STRLEN len;
+   Off_t *posn = (Off_t *) SvPV(pos,len);
+   if (f && len == sizeof(Off_t))
+    return PerlIO_seek(f,*posn,SEEK_SET);
+  }
+ errno = EINVAL;
+ return -1;
 }
 #else
-#ifndef PERLIO_IS_STDIO
 #undef PerlIO_setpos
 int
-PerlIO_setpos(PerlIO *f, const Fpos_t *pos)
+PerlIO_setpos(PerlIO *f, SV *pos)
 {
+ dTHX;
+ if (SvOK(pos))
+  {
+   STRLEN len;
+   Fpos_t *fpos = (Fpos_t *) SvPV(pos,len);
+   if (f && len == sizeof(Fpos_t))
+    {
 #if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
- return fsetpos64(f, pos);
+     return fsetpos64(f, fpos);
 #else
- return fsetpos(f, pos);
+     return fsetpos(f, fpos);
 #endif
+    }
+  }
+ errno = EINVAL;
+ return -1;
 }
 #endif
-#endif
 
 #ifndef HAS_FGETPOS
 #undef PerlIO_getpos
 int
-PerlIO_getpos(PerlIO *f, Fpos_t *pos)
+PerlIO_getpos(PerlIO *f, SV *pos)
 {
- *pos = PerlIO_tell(f);
- return *pos == -1 ? -1 : 0;
+ dTHX;
+ Off_t posn = PerlIO_tell(f);
+ sv_setpvn(pos,(char *)&posn,sizeof(posn));
+ return (posn == (Off_t)-1) ? -1 : 0;
 }
 #else
-#ifndef PERLIO_IS_STDIO
 #undef PerlIO_getpos
 int
-PerlIO_getpos(PerlIO *f, Fpos_t *pos)
+PerlIO_getpos(PerlIO *f, SV *pos)
 {
+ dTHX;
+ Fpos_t fpos;
+ int code;
 #if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64)
- return fgetpos64(f, pos);
+ code = fgetpos64(f, &fpos);
 #else
- return fgetpos(f, pos);
+ code = fgetpos(f, &fpos);
 #endif
+ sv_setpvn(pos,(char *)&fpos,sizeof(fpos));
+ return code;
 }
 #endif
-#endif
 
 #if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
 
diff --git a/perlio.h b/perlio.h
index 574b741c79..7d4cdcd2dc 100644
--- a/perlio.h
+++ b/perlio.h
@@ -299,10 +299,10 @@ extern PerlIO *	PerlIO_stdout		(void);
 extern PerlIO *	PerlIO_stderr		(void);
 #endif
 #ifndef PerlIO_getpos
-extern int	PerlIO_getpos		(PerlIO *,Fpos_t *);
+extern int	PerlIO_getpos		(PerlIO *,SV *);
 #endif
 #ifndef PerlIO_setpos
-extern int	PerlIO_setpos		(PerlIO *,const Fpos_t *);
+extern int	PerlIO_setpos		(PerlIO *,SV *);
 #endif
 #ifndef PerlIO_fdupopen
 extern PerlIO *	PerlIO_fdupopen		(pTHX_ PerlIO *);
diff --git a/perlsdio.h b/perlsdio.h
index aaedec4541..fd990c06d8 100644
--- a/perlsdio.h
+++ b/perlsdio.h
@@ -60,12 +60,6 @@
 #else
 #  define PerlIO_seek(f,o,w)		fseek(f,o,w)
 #endif
-#ifdef HAS_FGETPOS
-#define PerlIO_getpos(f,p)		fgetpos(f,p)
-#endif
-#ifdef HAS_FSETPOS
-#define PerlIO_setpos(f,p)		fsetpos(f,p)
-#endif
 
 #define PerlIO_rewind(f)		rewind(f)
 #define PerlIO_tmpfile()		tmpfile()