From: Nicholas Clark <nick@ccl4.org>
Date: Mon, 5 Nov 2007 13:58:52 +0000 (+0000)
Subject: As reported in bug #46207, change 30633 to PerlIO_exportFILE() and
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bbbc33d002fb16005d670814239b18d82b3e6229;p=p5sagit%2Fp5-mst-13.2.git

As reported in bug #46207, change 30633 to PerlIO_exportFILE() and
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
---

diff --git a/perlio.c b/perlio.c
index c0e7327..966894c 100644
--- 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. */