ccflags, not ldflags.

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

diff --git a/perlio.c b/perlio.c
index 8b4ca81..f74e569 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -175,6 +175,7 @@ PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names)
 PerlIO *
 PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
 {
+#ifndef PERL_MICRO
     if (f) {
        int fd = PerlLIO_dup(PerlIO_fileno(f));
        if (fd >= 0) {
@@ -189,6 +190,7 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
     else {
        SETERRNO(EBADF, SS$_IVCHAN);
     }
+#endif
     return NULL;
 }
 
@@ -517,13 +519,16 @@ PerlIO_list_push(pTHX_ PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg)
 PerlIO_list_t *
 PerlIO_clone_list(pTHX_ PerlIO_list_t *proto, CLONE_PARAMS *param)
 {
-    int i;
-    PerlIO_list_t *list = PerlIO_list_alloc(aTHX);
-    for (i=0; i < proto->cur; i++) {
-       SV *arg = Nullsv;
-       if (proto->array[i].arg)
-           arg = PerlIO_sv_dup(aTHX_ proto->array[i].arg,param);
-       PerlIO_list_push(aTHX_ list, proto->array[i].funcs, arg);
+    PerlIO_list_t *list = (PerlIO_list_t *) NULL;
+    if (proto) {
+       int i;
+       list = PerlIO_list_alloc(aTHX);
+       for (i=0; i < proto->cur; i++) {
+           SV *arg = Nullsv;
+           if (proto->array[i].arg)
+               arg = PerlIO_sv_dup(aTHX_ proto->array[i].arg,param);
+           PerlIO_list_push(aTHX_ list, proto->array[i].funcs, arg);
+       }
     }
     return list;
 }
@@ -538,6 +543,7 @@ PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param)
     PL_known_layers = PerlIO_clone_list(aTHX_ proto->Iknown_layers, param);
     PL_def_layerlist = PerlIO_clone_list(aTHX_ proto->Idef_layerlist, param);
     PerlIO_allocate(aTHX); /* root slot is never used */
+    PerlIO_debug("Clone %p from %p\n",aTHX,proto);
     while ((f = *table)) {
            int i;
            table = (PerlIO **) (f++);
@@ -556,6 +562,9 @@ PerlIO_destruct(pTHX)
 {
     PerlIO **table = &PL_perlio;
     PerlIO *f;
+#ifdef USE_ITHREADS
+    PerlIO_debug("Destruct %p\n",aTHX);
+#endif
     while ((f = *table)) {
        int i;
        table = (PerlIO **) (f++);
@@ -2015,15 +2024,6 @@ PerlIOUnix_refcnt_inc(int fd)
     }
 }
 
-void
-PerlIO_cleanup(pTHX)
-{
-    PerlIOUnix_refcnt_inc(0);
-    PerlIOUnix_refcnt_inc(1);
-    PerlIOUnix_refcnt_inc(2);
-    PerlIO_cleantable(aTHX_ &PL_perlio);
-}
-
 int
 PerlIOUnix_refcnt_dec(int fd)
 {
@@ -2041,6 +2041,24 @@ PerlIOUnix_refcnt_dec(int fd)
     return cnt;
 }
 
+void
+PerlIO_cleanup(pTHX)
+{
+    int i;
+#ifdef USE_ITHREADS
+    PerlIO_debug("Cleanup %p\n",aTHX);
+#endif
+    /* Raise STDIN..STDERR refcount so we don't close them */
+    for (i=0; i < 3; i++)
+       PerlIOUnix_refcnt_inc(i);
+    PerlIO_cleantable(aTHX_ &PL_perlio);
+    /* Restore STDIN..STDERR refcount */
+    for (i=0; i < 3; i++)
+       PerlIOUnix_refcnt_dec(i);
+}
+
+
+
 /*--------------------------------------------------------------------------------------*/
 /*
  * Bottom-most level for UNIX-like case
@@ -2464,23 +2482,10 @@ PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
     /* This assumes no layers underneath - which is what
        happens, but is not how I remember it. NI-S 2001/10/16
      */
-    int fd = PerlIO_fileno(o);
-    if (fd >= 0) {
-       char buf[8];
-       FILE *stdio = PerlSIO_fdopen(fd, PerlIO_modestr(o, buf));
-       if (stdio) {
-           if ((f = PerlIOBase_dup(aTHX_ f, o, param))) {
-               PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
-               PerlIOUnix_refcnt_inc(fd);
-           }
-           else {
-               PerlSIO_fclose(stdio);
-           }
-       }
-       else {
-           PerlLIO_close(fd);
-           f = NULL;
-       }
+    if ((f = PerlIOBase_dup(aTHX_ f, o, param))) {
+       FILE *stdio = PerlIOSelf(o, PerlIOStdio)->stdio;
+       PerlIOSelf(f, PerlIOStdio)->stdio = stdio;
+       PerlIOUnix_refcnt_inc(fileno(stdio));
     }
     return f;
 }
@@ -2495,6 +2500,8 @@ PerlIOStdio_close(PerlIO *f)
 #endif
     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 (
@@ -2865,19 +2872,26 @@ 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);
        if (f) {
-           PerlIO_push(aTHX_ f, self, mode, PerlIOArg);
-           fd = PerlIO_fileno(f);
-#if O_BINARY != O_TEXT
-           /*
-            * do something about failing setmode()? --jhi
-            */
-           PerlLIO_setmode(fd, O_BINARY);
-#endif
-           if (init && fd == 2) {
+            if (PerlIO_push(aTHX_ f, self, mode, PerlIOArg) == 0) {
+               /*
+                * if push fails during open, open fails. close will pop us.
+                */
+               PerlIO_close (f);
+               return NULL;
+           } else {
+               fd = PerlIO_fileno(f);
+#if (O_BINARY != O_TEXT) && !defined(__BEOS__)
                /*
-                * Initial stderr is unbuffered
+                * do something about failing setmode()? --jhi
                 */
-               PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
+               PerlLIO_setmode(fd, O_BINARY);
+#endif
+               if (init && fd == 2) {
+                   /*
+                    * Initial stderr is unbuffered
+                    */
+                   PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
+               }
            }
        }
     }