This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
As reported in bug #46207, change 30633 to PerlIO_exportFILE() and
authorNicholas Clark <nick@ccl4.org>
Mon, 5 Nov 2007 13:58:52 +0000 (13:58 +0000)
committerNicholas Clark <nick@ccl4.org>
Mon, 5 Nov 2007 13:58:52 +0000 (13:58 +0000)
PerlIO_releaseFILE() to manage the reference counts of fds correctly
has the side effect of making some XS modules "leak" descriptors.
This is because the typemap calls PerlIO_findFILE(), which sometimes
(but not always) calls PerlIO_exportFILE(). To be consistent,
PerlIO_fildFILE() needs to either always give you a reference, or
always not give you a reference. It seems better to do the latter as
the call to PerlIO_exportFILE() is only an implementation detail, so
arrange for it to immediately free up the reference that
PerlIO_exportFILE() created.

p4raw-id: //depot/perl@32224

perlio.c

index c0e7327..966894c 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -3578,6 +3578,7 @@ FILE *
 PerlIO_findFILE(PerlIO *f)
 {
     PerlIOl *l = *f;
+    FILE *stdio;
     while (l) {
        if (l->tab == &PerlIO_stdio) {
            PerlIOStdio *s = PerlIOSelf(&l, PerlIOStdio);
@@ -3586,7 +3587,19 @@ PerlIO_findFILE(PerlIO *f)
        l = *PerlIONext(&l);
     }
     /* Uses fallback "mode" via PerlIO_modestr() in PerlIO_exportFILE */
-    return PerlIO_exportFILE(f, NULL);
+    /* However, we're not really exporting a FILE * to someone else (who
+       becomes responsible for closing it, or calling PerlIO_releaseFILE())
+       So we need to undo its refernce count increase on the underlying file
+       descriptor. We have to do this, because if the loop above returns you
+       the FILE *, then *it* didn't increase any reference count. So there's
+       only one way to be consistent. */
+    stdio = PerlIO_exportFILE(f, NULL);
+    if (stdio) {
+       const int fd = fileno(stdio);
+       if (fd >= 0)
+           PerlIOUnix_refcnt_dec(fd);
+    }
+    return stdio;
 }
 
 /* Use this to reverse PerlIO_exportFILE calls. */