This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
I claim that the debugger is untestable until proven otherwise.
[perl5.git] / perlio.c
diff --git a/perlio.c b/perlio.c
index 91db1e1..91b7781 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -288,7 +288,7 @@ PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd,
            return PerlIO_tmpfile();
        else {
            char *name = SvPV_nolen(*args);
-           if (*mode == '#') {
+           if (*mode == IoTYPE_NUMERIC) {
                fd = PerlLIO_open3(name, imode, perm);
                if (fd >= 0)
                    return PerlIO_fdopen(fd, (char *) mode + 1);
@@ -1070,7 +1070,7 @@ PerlIO_default_layers(pTHX)
        PerlIO_funcs *osLayer = &PerlIO_unix;
        PL_def_layerlist = PerlIO_list_alloc(aTHX);
        PerlIO_define_layer(aTHX_ & PerlIO_unix);
-#if defined(WIN32) && !defined(UNDER_CE)
+#if defined(WIN32)
        PerlIO_define_layer(aTHX_ & PerlIO_win32);
 #if 0
        osLayer = &PerlIO_win32;
@@ -1960,7 +1960,7 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
     if (tab->Set_ptrcnt != NULL)
        l->flags |= PERLIO_F_FASTGETS;
     if (mode) {
-       if (*mode == '#' || *mode == 'I')
+       if (*mode == IoTYPE_NUMERIC || *mode == IoTYPE_IMPLICIT)
            mode++;
        switch (*mode++) {
        case 'r':
@@ -2033,8 +2033,11 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
     STDCHAR *buf = (STDCHAR *) vbuf;
     if (f) {
-       if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
+        if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) {
+           PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+           SETERRNO(EBADF, SS_IVCHAN);
            return 0;
+       }
        while (count > 0) {
            SSize_t avail = PerlIO_get_cnt(f);
            SSize_t take = 0;
@@ -2273,7 +2276,7 @@ int
 PerlIOUnix_oflags(const char *mode)
 {
     int oflags = -1;
-    if (*mode == 'I' || *mode == '#')
+    if (*mode == IoTYPE_IMPLICIT || *mode == IoTYPE_NUMERIC)
        mode++;
     switch (*mode) {
     case 'r':
@@ -2372,6 +2375,28 @@ PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
     return code;
 }
 
+IV
+PerlIOUnix_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
+{
+    int fd = PerlIOSelf(f, PerlIOUnix)->fd;
+    Off_t new;
+    if (PerlIOBase(f)->flags & PERLIO_F_NOTREG) {
+#ifdef  ESPIPE
+       SETERRNO(ESPIPE, LIB_INVARG);
+#else
+       SETERRNO(EINVAL, LIB_INVARG);
+#endif
+       return -1;
+    }
+    new  = PerlLIO_lseek(fd, offset, whence);
+    if (new == (Off_t) - 1)
+     {
+      return -1;
+     }
+    PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
+    return  0;
+}
+
 PerlIO *
 PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
                IV n, const char *mode, int fd, int imode,
@@ -2383,7 +2408,7 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
     }
     if (narg > 0) {
        char *path = SvPV_nolen(*args);
-       if (*mode == '#')
+       if (*mode == IoTYPE_NUMERIC)
            mode++;
        else {
            imode = PerlIOUnix_oflags(mode);
@@ -2394,7 +2419,7 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
        }
     }
     if (fd >= 0) {
-       if (*mode == 'I')
+       if (*mode == IoTYPE_IMPLICIT)
            mode++;
        if (!f) {
            f = PerlIO_allocate(aTHX);
@@ -2406,6 +2431,8 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
        }
         PerlIOUnix_setfd(aTHX_ f, fd, imode);
        PerlIOBase(f)->flags |= PERLIO_F_OPEN;
+       if (*mode == IoTYPE_APPEND)
+           PerlIOUnix_seek(aTHX_ f, 0, SEEK_END);
        return f;
     }
     else {
@@ -2482,28 +2509,6 @@ PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
     }
 }
 
-IV
-PerlIOUnix_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
-{
-    int fd = PerlIOSelf(f, PerlIOUnix)->fd;
-    Off_t new;
-    if (PerlIOBase(f)->flags & PERLIO_F_NOTREG) {
-#ifdef  ESPIPE
-       SETERRNO(ESPIPE, LIB_INVARG);
-#else
-       SETERRNO(EINVAL, LIB_INVARG);
-#endif
-       return -1;
-    }
-    new  = PerlLIO_lseek(fd, offset, whence);
-    if (new == (Off_t) - 1)
-     {
-      return -1;
-     }
-    PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
-    return  0;
-}
-
 Off_t
 PerlIOUnix_tell(pTHX_ PerlIO *f)
 {
@@ -2606,7 +2611,7 @@ PerlIOStdio_mode(const char *mode, char *tmode)
     while (*mode) {
        *tmode++ = *mode++;
     }
-#ifdef PERLIO_USING_CRLF
+#if defined(PERLIO_USING_CRLF) || defined(__CYGWIN__)
     *tmode++ = 'b';
 #endif
     *tmode = '\0';
@@ -2702,20 +2707,28 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
     else {
        if (narg > 0) {
            char *path = SvPV_nolen(*args);
-           if (*mode == '#') {
+           if (*mode == IoTYPE_NUMERIC) {
                mode++;
                fd = PerlLIO_open3(path, imode, perm);
            }
            else {
-               FILE *stdio = PerlSIO_fopen(path, mode);
+               FILE *stdio;
+               bool appended = FALSE;
+#ifdef __CYGWIN__
+               /* Cygwin wants its 'b' early. */
+               appended = TRUE;
+               mode = PerlIOStdio_mode(mode, tmode);
+#endif
+               stdio = PerlSIO_fopen(path, mode);
                if (stdio) {
                    PerlIOStdio *s;
                    if (!f) {
                        f = PerlIO_allocate(aTHX);
                    }
-                   if ((f = PerlIO_push(aTHX_ f, self,
-                                   (mode = PerlIOStdio_mode(mode, tmode)),
-                                   PerlIOArg))) {
+                   if (!appended)
+                       mode = PerlIOStdio_mode(mode, tmode);
+                   f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg);
+                   if (f) {
                        s = PerlIOSelf(f, PerlIOStdio);
                        s->stdio = stdio;
                        PerlIOUnix_refcnt_inc(fileno(s->stdio));
@@ -2730,7 +2743,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
        if (fd >= 0) {
            FILE *stdio = NULL;
            int init = 0;
-           if (*mode == 'I') {
+           if (*mode == IoTYPE_IMPLICIT) {
                init = 1;
                mode++;
            }
@@ -2977,6 +2990,8 @@ PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
        }
        else
            got = PerlSIO_fread(vbuf, 1, count, s);
+       if (got == 0 && PerlSIO_ferror(s))
+           got = -1;
        if (got >= 0 || errno != EINTR)
            break;
        PERL_ASYNC_CHECK();
@@ -3405,9 +3420,12 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
 {
     if (PerlIOValid(f)) {
        PerlIO *next = PerlIONext(f);
-       PerlIO_funcs *tab =  PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab);
-       next = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
-                         next, narg, args);
+       PerlIO_funcs *tab =
+            PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab);
+       if (tab && tab->Open)
+            next =
+                 (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
+                              next, narg, args);
        if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg, self) != 0) {
            return NULL;
        }
@@ -3415,14 +3433,17 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers,
     else {
        PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIO_default_btm());
        int init = 0;
-       if (*mode == 'I') {
+       if (*mode == IoTYPE_IMPLICIT) {
            init = 1;
            /*
             * mode++;
             */
        }
-       f = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
-                         f, narg, args);
+       if (tab && tab->Open)
+            f = (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
+                             f, narg, args);
+       else
+            SETERRNO(EINVAL, LIB_INVARG);
        if (f) {
            if (PerlIO_push(aTHX_ f, self, mode, PerlIOArg) == 0) {
                /*
@@ -4027,6 +4048,23 @@ PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
                 f, PerlIOBase(f)->tab->name, (mode) ? mode : "(Null)",
                 PerlIOBase(f)->flags);
 #endif
+    {
+      /* Enable the first CRLF capable layer you can find, but if none
+       * found, the one we just pushed is fine.  This results in at
+       * any given moment at most one CRLF-capable layer being enabled
+       * in the whole layer stack. */
+        PerlIO *g = PerlIONext(f);
+        while (g && *g) {
+             PerlIOl *b = PerlIOBase(g);
+             if (b && b->tab == &PerlIO_crlf) {
+                  if (!(b->flags & PERLIO_F_CRLF))
+                       b->flags |= PERLIO_F_CRLF;
+                  PerlIO_pop(aTHX_ f);
+                  return code;
+             }           
+             g = PerlIONext(g);
+        }
+    }
     return code;
 }
 
Unnamed repository; edit this file 'description' to name the repository.