Update README.vos and release vos build macros

[p5sagit/p5-mst-13.2.git] / perlio.c

diff --git a/perlio.c b/perlio.c
index fde7ea9..bcfa256 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -186,7 +186,15 @@ PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names)
 PerlIO *
 PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
 {
-#ifndef PERL_MICRO
+#ifdef PERL_MICRO
+    return NULL;
+#else
+#ifdef PERL_IMPLICIT_SYS
+    return PerlSIO_fdupopen(f); 
+#else
+#ifdef WIN32
+    return win32_fdupopen(f);
+#else
     if (f) {
        int fd = PerlLIO_dup(PerlIO_fileno(f));
        if (fd >= 0) {
@@ -206,6 +214,8 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
     }
 #endif
     return NULL;
+#endif
+#endif
 }
 
 
@@ -601,10 +611,6 @@ PerlIO_destruct(pTHX)
            f++;
        }
     }
-    PerlIO_list_free(aTHX_ PL_known_layers);
-    PL_known_layers = NULL;
-    PerlIO_list_free(aTHX_ PL_def_layerlist);
-    PL_def_layerlist = NULL;
 }
 
 void
@@ -1040,9 +1046,8 @@ PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 
 int
 PerlIO_apply_layera(pTHX_ PerlIO *f, const char *mode,
-                   PerlIO_list_t *layers, IV n)
+                   PerlIO_list_t *layers, IV n, IV max)
 {
-    IV max = layers->cur;
     int code = 0;
     while (n < max) {
        PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n, NULL);
@@ -1065,7 +1070,7 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
        PerlIO_list_t *layers = PerlIO_list_alloc(aTHX);
        code = PerlIO_parse_layers(aTHX_ layers, names);
        if (code == 0) {
-           code = PerlIO_apply_layera(aTHX_ f, mode, layers, 0);
+           code = PerlIO_apply_layera(aTHX_ f, mode, layers, 0, layers->cur);
        }
        PerlIO_list_free(aTHX_ layers);
     }
@@ -1205,7 +1210,7 @@ PerlIO_context_layers(pTHX_ const char *mode)
                 * Skip to write part
                 */
                const char *s = strchr(type, 0);
-               if (s && (s - type) < len) {
+               if (s && (STRLEN)(s - type) < len) {
                    type = s + 1;
                }
            }
@@ -1356,8 +1361,9 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
                     * More layers above the one that we used to open -
                     * apply them now
                     */
-                   if (PerlIO_apply_layera(aTHX_ f, mode, layera, n + 1)
-                       != 0) {
+                   if (PerlIO_apply_layera(aTHX_ f, mode, layera, n + 1, layera->cur) != 0) {
+                       /* If pushing layers fails close the file */
+                       PerlIO_close(f);
                        f = NULL;
                    }
                }
@@ -1896,7 +1902,7 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
            SSize_t avail = PerlIO_get_cnt(f);
            SSize_t take = 0;
            if (avail > 0)
-               take = (count < avail) ? count : avail;
+               take = ((SSize_t)count < avail) ? count : avail;
            if (take > 0) {
                STDCHAR *ptr = PerlIO_get_ptr(f);
                Copy(ptr, buf, take, STDCHAR);
@@ -2071,7 +2077,9 @@ PerlIO_cleanup(pTHX)
 {
     int i;
 #ifdef USE_ITHREADS
-    PerlIO_debug("Cleanup %p\n",aTHX);
+    PerlIO_debug("Cleanup layers for %p\n",aTHX);
+#else
+    PerlIO_debug("Cleanup layers\n");
 #endif
     /* Raise STDIN..STDERR refcount so we don't close them */
     for (i=0; i < 3; i++)
@@ -2080,6 +2088,15 @@ PerlIO_cleanup(pTHX)
     /* Restore STDIN..STDERR refcount */
     for (i=0; i < 3; i++)
        PerlIOUnix_refcnt_dec(i);
+
+    if (PL_known_layers) {
+       PerlIO_list_free(aTHX_ PL_known_layers);
+       PL_known_layers = NULL;
+    }
+    if(PL_def_layerlist) {
+       PerlIO_list_free(aTHX_ PL_def_layerlist);
+       PL_def_layerlist = NULL;
+    }
 }
 
 
@@ -2182,7 +2199,7 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
                IV n, const char *mode, int fd, int imode,
                int perm, PerlIO *f, int narg, SV **args)
 {
-    if (f) {
+    if (PerlIOValid(f)) {
        if (PerlIOBase(f)->flags & PERLIO_F_OPEN)
            (*PerlIOBase(f)->tab->Close)(aTHX_ f);
     }
@@ -2204,11 +2221,14 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
            mode++;
        if (!f) {
            f = PerlIO_allocate(aTHX);
+       }
+       if (!PerlIOValid(f)) {
            s = PerlIOSelf(PerlIO_push(aTHX_ f, self, mode, PerlIOArg),
                           PerlIOUnix);
        }
-       else
+       else {
            s = PerlIOSelf(f, PerlIOUnix);
+       }
        s->fd = fd;
        s->oflags = imode;
        PerlIOBase(f)->flags |= PERLIO_F_OPEN;
@@ -2428,7 +2448,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
                 int perm, PerlIO *f, int narg, SV **args)
 {
     char tmode[8];
-    if (f) {
+    if (PerlIOValid(f)) {
        char *path = SvPV_nolen(*args);
        PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
        FILE *stdio;
@@ -2451,9 +2471,11 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
            else {
                FILE *stdio = PerlSIO_fopen(path, mode);
                if (stdio) {
-                   PerlIOStdio *s =
-                       PerlIOSelf(PerlIO_push
-                                  (aTHX_(f = PerlIO_allocate(aTHX)), self,
+                   PerlIOStdio *s;
+                   if (!f) {
+                       f = PerlIO_allocate(aTHX);
+                   }
+                   s = PerlIOSelf(PerlIO_push(aTHX_ f, self,
                                    (mode = PerlIOStdio_mode(mode, tmode)),
                                    PerlIOArg),
                                   PerlIOStdio);
@@ -2488,10 +2510,11 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
                                       PerlIOStdio_mode(mode, tmode));
            }
            if (stdio) {
-               PerlIOStdio *s =
-                   PerlIOSelf(PerlIO_push
-                              (aTHX_(f = PerlIO_allocate(aTHX)), self,
-                               mode, PerlIOArg), PerlIOStdio);
+               PerlIOStdio *s;
+               if (!f) {
+                   f = PerlIO_allocate(aTHX);
+               }
+               s = PerlIOSelf(PerlIO_push(aTHX_ f, self, mode, PerlIOArg), PerlIOStdio);
                s->stdio = stdio;
                PerlIOUnix_refcnt_inc(fileno(s->stdio));
                return f;
@@ -2537,8 +2560,7 @@ PerlIOStdio_close(pTHX_ PerlIO *f)
     FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     if (PerlIOUnix_refcnt_dec(fileno(stdio)) > 0) {
        /* Do not close it but do flush any buffers */
-       PerlIO_flush(f);
-       return 0;
+        return PerlIO_flush(f);
     }
     return (
 #ifdef SOCKS5_VERSION_NAME
@@ -2881,7 +2903,7 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
             */
        }
        f = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
-                         NULL, narg, args);
+                         f, narg, args);
        if (f) {
             if (PerlIO_push(aTHX_ f, self, mode, PerlIOArg) == 0) {
                /*
@@ -2891,18 +2913,23 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
                return NULL;
            } else {
                fd = PerlIO_fileno(f);
-#ifdef PERLIO_USING_CRLF
-               /*
-                * do something about failing setmode()? --jhi
-                */
-               PerlLIO_setmode(fd, O_BINARY);
-#endif
                if (init && fd == 2) {
                    /*
                     * Initial stderr is unbuffered
                     */
                    PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
                }
+#ifdef PERLIO_USING_CRLF
+#  ifdef PERLIO_IS_BINMODE_FD
+               if (PERLIO_IS_BINMODE_FD(fd))
+                   PerlIO_binmode(f,  '<'/*not used*/, O_BINARY, Nullch);
+               else
+#  endif
+               /*
+                * do something about failing setmode()? --jhi
+                */
+               PerlLIO_setmode(fd, O_BINARY);
+#endif
            }
        }
     }
@@ -3004,7 +3031,7 @@ PerlIOBuf_fill(pTHX_ PerlIO *f)
        if (avail > 0) {
            STDCHAR *ptr = PerlIO_get_ptr(n);
            SSize_t cnt = avail;
-           if (avail > b->bufsiz)
+           if (avail > (SSize_t)b->bufsiz)
                avail = b->bufsiz;
            Copy(ptr, b->buf, avail, STDCHAR);
            PerlIO_set_ptrcnt(n, ptr + avail, cnt - avail);
@@ -3363,11 +3390,11 @@ PerlIOPending_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     SSize_t avail = PerlIO_get_cnt(f);
     SSize_t got = 0;
-    if (count < avail)
+    if ((SSize_t)count < avail)
        avail = count;
     if (avail > 0)
        got = PerlIOBuf_read(aTHX_ f, vbuf, avail);
-    if (got >= 0 && got < count) {
+    if (got >= 0 && got < (SSize_t)count) {
        SSize_t more =
            PerlIO_read(f, ((STDCHAR *) vbuf) + got, count - got);
        if (more >= 0 || got == 0)
@@ -3492,8 +3519,8 @@ PerlIOCrlf_get_cnt(pTHX_ PerlIO *f)
        PerlIO_get_base(f);
     if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) {
        PerlIOCrlf *c = PerlIOSelf(f, PerlIOCrlf);
-       if ((PerlIOBase(f)->flags & PERLIO_F_CRLF) && !c->nl) {
-           STDCHAR *nl = b->ptr;
+       if ((PerlIOBase(f)->flags & PERLIO_F_CRLF) && (!c->nl || *c->nl == 0xd)) {
+           STDCHAR *nl = (c->nl) ? c->nl : b->ptr;
          scan:
            while (nl < b->end && *nl != 0xd)
                nl++;
@@ -3558,7 +3585,6 @@ PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
 {
     PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
     PerlIOCrlf *c = PerlIOSelf(f, PerlIOCrlf);
-    IV flags = PerlIOBase(f)->flags;
     if (!b->buf)
        PerlIO_get_base(f);
     if (!ptr) {
@@ -3575,9 +3601,11 @@ PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
        ptr -= cnt;
     }
     else {
+#if 0
        /*
         * Test code - delete when it works ...
         */
+       IV flags = PerlIOBase(f)->flags;
        STDCHAR *chk = (c->nl) ? (c->nl+1) : b->end;
         if (ptr+cnt == c->nl && c->nl+1 == b->end && *c->nl == 0xd) {
          /* Defered CR at end of buffer case - we lied about count */
@@ -3585,7 +3613,6 @@ PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt)
         }
        chk -= cnt;
 
-#ifdef USE_ATTRIBUTES_FOR_PERLIO
        if (ptr != chk ) {
            Perl_croak(aTHX_ "ptr wrong %p != %p fl=%08" UVxf
                       " nl=%p e=%p for %d", ptr, chk, flags, c->nl,