Upgrade to CPAN-1.88_53.

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

diff --git a/perlio.c b/perlio.c
index a5dc32e..ddc0ad8 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -114,7 +114,15 @@ int mkstemp(char*);
        else                                                    \
                SETERRNO(EBADF, SS_IVCHAN)
 
+#if defined(__osf__) && _XOPEN_SOURCE < 500
+extern int   fseeko(FILE *, off_t, int);
+extern off_t ftello(FILE *);
+#endif
+
 #ifndef USE_SFIO
+
+EXTERN_C int perlsio_binmode(FILE *fp, int iotype, int mode);
+
 int
 perlsio_binmode(FILE *fp, int iotype, int mode)
 {
@@ -465,12 +473,19 @@ PerlIO_debug(const char *fmt, ...)
     va_list ap;
     dSYS;
     va_start(ap, fmt);
-    if (!PL_perlio_debug_fd && !PL_tainting && PL_uid == PL_euid && PL_gid == PL_egid) {
-       const char * const s = PerlEnv_getenv("PERLIO_DEBUG");
-       if (s && *s)
-           PL_perlio_debug_fd = PerlLIO_open3(s, O_WRONLY | O_CREAT | O_APPEND, 0666);
-       else
+    if (!PL_perlio_debug_fd) {
+       if (!PL_tainting && PL_uid == PL_euid && PL_gid == PL_egid) {
+           const char * const s = PerlEnv_getenv("PERLIO_DEBUG");
+           if (s && *s)
+               PL_perlio_debug_fd
+                   = PerlLIO_open3(s, O_WRONLY | O_CREAT | O_APPEND, 0666);
+           else
+               PL_perlio_debug_fd = -1;
+       } else {
+           /* tainting or set*id, so ignore the environment, and ensure we
+              skip these tests next time through.  */
            PL_perlio_debug_fd = -1;
+       }
     }
     if (PL_perlio_debug_fd > 0) {
        dTHX;
@@ -1431,8 +1446,9 @@ PerlIO_layer_from_ref(pTHX_ SV *sv)
        return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Code"), 0);
     case SVt_PVGV:
        return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Glob"), 0);
+    default:
+       return NULL;
     }
-    return NULL;
 }
 
 PerlIO_list_t *
@@ -2260,8 +2276,8 @@ S_more_refcounted_fds(pTHX_ const int new_fd) {
 
     assert (new_max > new_fd);
 
-    new_array
-       = PerlMemShared_realloc(PL_perlio_fd_refcnt, new_max * sizeof(int));
+    new_array =
+       (int*) PerlMemShared_realloc(PL_perlio_fd_refcnt, new_max * sizeof(int));
 
     if (!new_array) {
 #ifdef USE_THREADS
@@ -2367,8 +2383,6 @@ PerlIO_cleanup(pTHX)
        PerlIO_list_free(aTHX_ PL_def_layerlist);
        PL_def_layerlist = NULL;
     }
-
-    Safefree(PL_perlio_fd_refcnt);
 }
 
 
@@ -2963,6 +2977,7 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
     f->_fileno = -1;
     return 1;
 #  elif defined(__sun__)
+    PERL_UNUSED_ARG(f);
     return 0;
 #  elif defined(__hpux)
     f->__fileH = 0xff;
@@ -4184,6 +4199,21 @@ typedef struct {
                                 * buffer */
 } PerlIOCrlf;
 
+/* Inherit the PERLIO_F_UTF8 flag from previous layer.
+ * Otherwise the :crlf layer would always revert back to
+ * raw mode.
+ */
+static void
+S_inherit_utf8_flag(PerlIO *f)
+{
+    PerlIO *g = PerlIONext(f);
+    if (PerlIOValid(g)) {
+       if (PerlIOBase(g)->flags & PERLIO_F_UTF8) {
+           PerlIOBase(f)->flags |= PERLIO_F_UTF8;
+       }
+    }
+}
+
 IV
 PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
 {
@@ -4201,17 +4231,19 @@ PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
        * any given moment at most one CRLF-capable layer being enabled
        * in the whole layer stack. */
         PerlIO *g = PerlIONext(f);
-        while (g && *g) {
+        while (PerlIOValid(g)) {
              PerlIOl *b = PerlIOBase(g);
              if (b && b->tab == &PerlIO_crlf) {
                   if (!(b->flags & PERLIO_F_CRLF))
                        b->flags |= PERLIO_F_CRLF;
+                  S_inherit_utf8_flag(g);
                   PerlIO_pop(aTHX_ f);
                   return code;
              }           
              g = PerlIONext(g);
         }
     }
+    S_inherit_utf8_flag(f);
     return code;
 }
 
@@ -4585,7 +4617,14 @@ PerlIOMmap_unmap(pTHX_ PerlIO *f)
     if (m->len) {
        PerlIOBuf * const b = &m->base;
        if (b->buf) {
-           code = munmap(m->mptr, m->len);
+           /* The munmap address argument is tricky: depending on the
+            * standard it is either "void *" or "caddr_t" (which is
+            * usually "char *" (signed or unsigned).  If we cast it
+            * to "void *", those that have it caddr_t and an uptight
+            * C++ compiler, will freak out.  But casting it as char*
+            * should work.  Maybe.  (Using Mmap_t figured out by
+            * Configure doesn't always work, apparently.) */
+           code = munmap((char*)m->mptr, m->len);
            b->buf = NULL;
            m->len = 0;
            m->mptr = NULL;