Re: [perl #56644] PerlIO resource leaks on open() and then :pop in :unix and :stdio

From: "Goro Fuji" <gfuji@cpan.org>
Message-ID: <efb9c59b0807061604q476025e9n85893f131a6bf23e@mail.gmail.com>

p4raw-id: //depot/perl@34775

4 files changed, 41 insertions, 6 deletions

diff --git a/MANIFEST b/MANIFEST
index 278c9f0ea6..8a6d2418c8 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -969,6 +969,7 @@ ext/PerlIO/scalar/t/scalar_ungetc.t	Tests for PerlIO layer for scalars
 ext/PerlIO/t/encoding.t		See if PerlIO encoding conversion works
 ext/PerlIO/t/fail.t		See if bad layers fail
 ext/PerlIO/t/fallback.t		See if PerlIO fallbacks work
+ext/PerlIO/t/ioleaks.t		See if PerlIO layers are leaking
 ext/PerlIO/t/open.t		See if PerlIO certain special opens work
 ext/PerlIO/t/PerlIO.t		See if PerlIO works
 ext/PerlIO/t/scalar.t		See if PerlIO::scalar works
diff --git a/ext/PerlIO/t/ioleaks.t b/ext/PerlIO/t/ioleaks.t
new file mode 100644
index 0000000000..54b0ee1fab
--- /dev/null
+++ b/ext/PerlIO/t/ioleaks.t
@@ -0,0 +1,23 @@
+#!perl
+# ioleaks.t
+
+use strict;
+use warnings;
+use Test::More 'no_plan';
+
+# :unix   -> not ok
+# :stdio  -> not ok
+# :perlio -> ok
+# :crlf   -> ok
+
+foreach my $layer(qw(:unix :stdio  :perlio :crlf)){
+	my $base_fd = do{ open my $in, '<', $0 or die $!; fileno $in };
+
+	for(1 .. 3){
+		open my $fh, "<$layer", $0 or die $!;
+
+		is fileno($fh), $base_fd, $layer;
+		binmode $fh, ':pop';
+	}
+}
+
diff --git a/perlio.c b/perlio.c
index a3ea344620..436bb85a68 100644
--- a/perlio.c
+++ b/perlio.c
@@ -2736,10 +2736,15 @@ PerlIOUnix_tell(pTHX_ PerlIO *f)
     return PerlLIO_lseek(PerlIOSelf(f, PerlIOUnix)->fd, 0, SEEK_CUR);
 }
 
-
 IV
 PerlIOUnix_close(pTHX_ PerlIO *f)
 {
+	return PerlIOBase_noop_ok(aTHX_ f);
+}
+
+IV
+PerlIOUnix_popped(pTHX_ PerlIO *f)
+{
     dVAR;
     const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
     int code = 0;
@@ -2772,7 +2777,7 @@ PERLIO_FUNCS_DECL(PerlIO_unix) = {
     sizeof(PerlIOUnix),
     PERLIO_K_RAW,
     PerlIOUnix_pushed,
-    PerlIOBase_popped,
+    PerlIOUnix_popped,
     PerlIOUnix_open,
     PerlIOBase_binmode,         /* binmode */
     NULL,
@@ -3122,6 +3127,12 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f)
 IV
 PerlIOStdio_close(pTHX_ PerlIO *f)
 {
+	return PerlIOBase_noop_ok(aTHX_ f);
+}
+
+IV
+PerlIOStdio_popped(pTHX_ PerlIO *f)
+{
     FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     if (!stdio) {
 	errno = EBADF;
@@ -3558,7 +3569,7 @@ PERLIO_FUNCS_DECL(PerlIO_stdio) = {
     sizeof(PerlIOStdio),
     PERLIO_K_BUFFERED|PERLIO_K_RAW,
     PerlIOStdio_pushed,
-    PerlIOBase_popped,
+    PerlIOStdio_popped,
     PerlIOStdio_open,
     PerlIOBase_binmode,         /* binmode */
     NULL,
diff --git a/pod/perliol.pod b/pod/perliol.pod
index 136faa6b6e..a560d970cb 100644
--- a/pod/perliol.pod
+++ b/pod/perliol.pod
@@ -145,7 +145,7 @@ same as the public C<PerlIO_xxxxx> functions:
    IV		(*Pushed)(pTHX_ PerlIO *f,const char *mode,SV *arg, PerlIO_funcs *tab);
    IV		(*Popped)(pTHX_ PerlIO *f);
    PerlIO *	(*Open)(pTHX_ PerlIO_funcs *tab,
-  			AV *layers, IV n,
+  			PerlIO_list_t *layers, IV n,
   			const char *mode,
   			int fd, int imode, int perm,
   			PerlIO *old,
@@ -486,7 +486,7 @@ C<PerlIO_fdopen> and C<PerlIO_reopen>.  The full prototype is as
 follows:
 
  PerlIO *	(*Open)(pTHX_ PerlIO_funcs *tab,
-			AV *layers, IV n,
+			PerlIO_list_t *layers, IV n,
 			const char *mode,
 			int fd, int imode, int perm,
 			PerlIO *old,
@@ -494,7 +494,7 @@ follows:
 
 Open should (perhaps indirectly) call C<PerlIO_allocate()> to allocate
 a slot in the table and associate it with the layers information for
-the opened file, by calling C<PerlIO_push>.  The I<layers> AV is an
+the opened file, by calling C<PerlIO_push>.  The I<layers> is an
 array of all the layers destined for the C<PerlIO *>, and any
 arguments passed to them, I<n> is the index into that array of the
 layer being called. The macro C<PerlIOArg> will return a (possibly