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

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

p4raw-id: //depot/perlio@8025

diff --git a/ext/IO/IO.xs b/ext/IO/IO.xs
index 6da48dc..13b198c 100644 (file)
--- 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 374087f..4791232 100644 (file)
--- 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 4f3497e..e2df18e 100644 (file)
--- 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 a0856af..874dece 100644 (file)
--- 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 574b741..7d4cdcd 100644 (file)
--- 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 aaedec4..fd990c0 100644 (file)
--- 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()