[perl #78494] Pipes cause threads to hang on join()

or on close() in either thread.

close() in one thread blocks until close() is called in the other
thread, because both closes are waiting for the child process to end.

Since we have a reference-counting mechanism for the underlying
fileno, we can use that to determine whether close() should wait.

This does not solve the problem of close $OUT block when it has been
duplicated via open $OUT2, ">&" and $OUT2 is still in scope.

1 files changed, 31 insertions, 0 deletions

diff --git a/perlio.c b/perlio.c
index 07e297ec8e..6a092d0b93 100644
--- a/perlio.c
+++ b/perlio.c
@@ -2455,6 +2455,37 @@ PerlIOUnix_refcnt_dec(int fd)
     return cnt;
 }
 
+int
+PerlIOUnix_refcnt(int fd)
+{
+    dTHX;
+    int cnt = 0;
+    if (fd >= 0) {
+	dVAR;
+#ifdef USE_ITHREADS
+	MUTEX_LOCK(&PL_perlio_mutex);
+#endif
+	if (fd >= PL_perlio_fd_refcnt_size) {
+	    /* diag_listed_as: refcnt: fd %d%s */
+	    Perl_croak(aTHX_ "refcnt: fd %d >= refcnt_size %d\n",
+		       fd, PL_perlio_fd_refcnt_size);
+	}
+	if (PL_perlio_fd_refcnt[fd] <= 0) {
+	    /* diag_listed_as: refcnt: fd %d%s */
+	    Perl_croak(aTHX_ "refcnt: fd %d: %d <= 0\n",
+		       fd, PL_perlio_fd_refcnt[fd]);
+	}
+	cnt = PL_perlio_fd_refcnt[fd];
+#ifdef USE_ITHREADS
+	MUTEX_UNLOCK(&PL_perlio_mutex);
+#endif
+    } else {
+	/* diag_listed_as: refcnt: fd %d%s */
+	Perl_croak(aTHX_ "refcnt: fd %d < 0\n", fd);
+    }
+    return cnt;
+}
+
 void
 PerlIO_cleanup(pTHX)
 {