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

[p5sagit/p5-mst-13.2.git] / ext / IO / IO.xs

diff --git a/ext/IO/IO.xs b/ext/IO/IO.xs
index 1d0e356..13b198c 100644 (file)
--- a/ext/IO/IO.xs
+++ b/ext/IO/IO.xs
@@ -4,6 +4,7 @@
  * modify it under the same terms as Perl itself.
  */
 
+#define PERL_NO_GET_CONTEXT
 #include "EXTERN.h"
 #define PERLIO_NOT_STDIO 1
 #include "perl.h"
@@ -27,20 +28,7 @@ typedef FILE * InputStream;
 typedef FILE * OutputStream;
 #endif
 
-#include "patchlevel.h"
-
-#if (PATCHLEVEL < 3) || ((PATCHLEVEL == 3) && (SUBVERSION < 22))
-     /* before 5.003_22 */
-#    define MY_start_subparse(fmt,flags) start_subparse()
-#else
-#  if (PATCHLEVEL == 3) && (SUBVERSION == 22)
-     /* 5.003_22 */
-#    define MY_start_subparse(fmt,flags) start_subparse(flags)
-#  else
-     /* 5.003_23  onwards */
-#    define MY_start_subparse(fmt,flags) start_subparse(fmt,flags)
-#  endif
-#endif
+#define MY_start_subparse(fmt,flags) start_subparse(fmt,flags)
 
 #ifndef gv_stashpvn
 #define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
@@ -71,29 +59,34 @@ 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 
-        * get SysV behaviour by mistake
-        */
-       RETVAL = RETVAL & O_NONBLOCK ? 0 : 1;
-
-       if ((mode & O_NDELAY) || ((block == 0) && !(mode & O_NONBLOCK))) {
-           int ret;
-           mode = (mode & ~O_NDELAY) | O_NONBLOCK;
-           ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
-           if(ret < 0)
-               RETVAL = ret;
-       }
-       else if ((mode & O_NDELAY) || ((block > 0) && (mode & O_NONBLOCK))) {
-           int ret;
-           mode &= ~(O_NONBLOCK | O_NDELAY);
-           ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
-           if(ret < 0)
-               RETVAL = ret;
+       /* 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
+        * after a successful F_SETFL of an O_NONBLOCK. */
+       RETVAL = RETVAL & (O_NONBLOCK | O_NDELAY) ? 0 : 1;
+
+       if (block >= 0) {
+           if ((mode & O_NDELAY) || ((block == 0) && !(mode & O_NONBLOCK))) {
+               int ret;
+               mode = (mode & ~O_NDELAY) | O_NONBLOCK;
+               ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
+               if(ret < 0)
+                   RETVAL = ret;
+           }
+           else
+              if ((mode & O_NDELAY) || ((block > 0) && (mode & O_NONBLOCK))) {
+               int ret;
+               mode &= ~(O_NONBLOCK | O_NDELAY);
+               ret = fcntl(PerlIO_fileno(f),F_SETFL,mode);
+               if(ret < 0)
+                   RETVAL = ret;
+              }
        }
 #else
-       /* Standard POSIX */ 
+       /* Standard POSIX */
        RETVAL = RETVAL & O_NONBLOCK ? 0 : 1;
 
        if ((block == 0) && !(mode & O_NONBLOCK)) {
@@ -110,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;
@@ -148,13 +141,18 @@ fgetpos(handle)
        InputStream     handle
     CODE:
        if (handle) {
-           Fpos_t pos;
 #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);
+           if (fgetpos(handle, &pos)) {
+               ST(0) = &PL_sv_undef;
+           } else {
+               ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
+           }
 #endif
-           ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t)));
        }
        else {
            ST(0) = &PL_sv_undef;
@@ -166,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;
@@ -209,7 +214,7 @@ new_tmpfile(packname = "IO::File")
 
 MODULE = IO    PACKAGE = IO::Poll
 
-void   
+void
 _poll(timeout,...)
        int timeout;
 PPCODE:
@@ -369,8 +374,7 @@ setvbuf(handle, buf, type, size)
        int             type
        int             size
     CODE:
-/* Should check HAS_SETVBUF once Configure tests for that */
-#if defined(PERLIO_IS_STDIO) && defined(_IOFBF)
+#if defined(PERLIO_IS_STDIO) && defined(_IOFBF) && defined(HAS_SETVBUF)
        if (!handle)                    /* Try input stream. */
            handle = IoIFP(sv_2io(ST(0)));
        if (handle)
@@ -466,11 +470,4 @@ BOOT:
 #ifdef SEEK_END
         newCONSTSUB(stash,"SEEK_END", newSViv(SEEK_END));
 #endif
-    /*
-     * constant subs for IO
-     */
-    stash = gv_stashpvn("IO", 2, TRUE);
-#ifdef EINPROGRESS
-        newCONSTSUB(stash,"EINPROGRESS", newSViv(EINPROGRESS));
-#endif
 }