Fix a memory leak in IO::Poll

perl-5.24.0-perl-129788-IO-Poll-fix-memory-leak.patch

@@ -0,0 +1,134 @@
+From 478d23ef9e7700e20a75907648dd4c53b1b4f544 Mon Sep 17 00:00:00 2001
+From: Tony Cook <tony@develop-help.com>
+Date: Tue, 25 Oct 2016 16:17:18 +1100
+Subject: [PATCH] (perl #129788) IO::Poll: fix memory leak
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Petr Pisar: Ported to 5.24.0:
+
+commit 6de2dd46140d0d3ab6813e26940d7b74418b0260
+Author: Tony Cook <tony@develop-help.com>
+Date:   Tue Oct 25 16:17:18 2016 +1100
+
+    (perl #129788) IO::Poll: fix memory leak
+
+    Whenever a magical/tied scalar which dies upon read was passed to _poll()
+    temporary buffer for events was not freed.
+
+    Adapted from a patch by Sergey Aleynikov <sergey.aleynikov@gmail.com>
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ MANIFEST            |  1 +
+ META.json           |  1 +
+ META.yml            |  1 +
+ dist/IO/IO.xs       |  3 +--
+ dist/IO/t/io_leak.t | 37 +++++++++++++++++++++++++++++++++++++
+ 5 files changed, 41 insertions(+), 2 deletions(-)
+ create mode 100644 dist/IO/t/io_leak.t
+
+diff --git a/MANIFEST b/MANIFEST
+index 2cdf616..3b5f8fb 100644
+--- a/MANIFEST
++++ b/MANIFEST
+@@ -3228,6 +3228,7 @@ dist/IO/t/io_dir.t		See if directory-related methods from IO work
+ dist/IO/t/io_dup.t		See if dup()-related methods from IO work
+ dist/IO/t/io_file_export.t	Test IO::File exports
+ dist/IO/t/io_file.t		See if binmode()-related methods on IO::File work
++dist/IO/t/io_leak.t		See if IO leaks SVs (only run in core)
+ dist/IO/t/io_linenum.t		See if I/O line numbers are tracked correctly
+ dist/IO/t/io_multihomed.t	See if INET sockets work with multi-homed hosts
+ dist/IO/t/io_pipe.t		See if pipe()-related methods from IO work
+diff --git a/META.json b/META.json
+index 4cb21a9..2809b58 100644
+--- a/META.json
++++ b/META.json
+@@ -84,6 +84,7 @@
+          "dist/IO/t/io_dup.t",
+          "dist/IO/t/io_file.t",
+          "dist/IO/t/io_file_export.t",
++         "dist/IO/t/io_leak.t",
+          "dist/IO/t/io_linenum.t",
+          "dist/IO/t/io_multihomed.t",
+          "dist/IO/t/io_pipe.t",
+diff --git a/META.yml b/META.yml
+index 13a2bb3..7494d2a 100644
+--- a/META.yml
++++ b/META.yml
+@@ -81,6 +81,7 @@ no_index:
+     - dist/IO/t/io_dup.t
+     - dist/IO/t/io_file.t
+     - dist/IO/t/io_file_export.t
++    - dist/IO/t/io_leak.t
+     - dist/IO/t/io_linenum.t
+     - dist/IO/t/io_multihomed.t
+     - dist/IO/t/io_pipe.t
+diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs
+index fe749a6..15ef9b2 100644
+--- a/dist/IO/IO.xs
++++ b/dist/IO/IO.xs
+@@ -318,7 +318,7 @@ PPCODE:
+ {
+ #ifdef HAS_POLL
+     const int nfd = (items - 1) / 2;
+-    SV *tmpsv = NEWSV(999,nfd * sizeof(struct pollfd));
++    SV *tmpsv = sv_2mortal(NEWSV(999,nfd * sizeof(struct pollfd)));
+     /* We should pass _some_ valid pointer even if nfd is zero, but it
+      * doesn't matter what it is, since we're telling it to not check any fds.
+      */
+@@ -337,7 +337,6 @@ PPCODE:
+ 	    sv_setiv(ST(i), fds[j].revents); i++;
+ 	}
+     }
+-    SvREFCNT_dec(tmpsv);
+     XSRETURN_IV(ret);
+ #else
+ 	not_here("IO::Poll::poll");
+diff --git a/dist/IO/t/io_leak.t b/dist/IO/t/io_leak.t
+new file mode 100644
+index 0000000..08cbe2b
+--- /dev/null
++++ b/dist/IO/t/io_leak.t
+@@ -0,0 +1,37 @@
++#!/usr/bin/perl
++
++use warnings;
++use strict;
++
++use Test::More;
++
++eval { require XS::APItest; XS::APItest->import('sv_count'); 1 }
++  or plan skip_all => "No XS::APItest::sv_count() available";
++
++plan tests => 1;
++
++sub leak {
++    my ($n, $delta, $code, $name) = @_;
++    my $sv0 = 0;
++    my $sv1 = 0;
++    for my $i (1..$n) {
++	&$code();
++	$sv1 = sv_count();
++	$sv0 = $sv1 if $i == 1;
++    }
++    cmp_ok($sv1-$sv0, '<=', ($n-1)*$delta, $name);
++}
++
++# [perl #129788] IO::Poll shouldn't leak on errors
++{
++    package io_poll_leak;
++    use IO::Poll;
++
++    sub TIESCALAR { bless {} }
++    sub FETCH { die }
++
++    tie(my $a, __PACKAGE__);
++    sub f {eval { IO::Poll::_poll(0, $a, 1) }}
++
++    ::leak(5, 0, \&f, q{IO::Poll::_poll shouldn't leak});
++}
+-- 
+2.7.4
+

perl.spec

@@ -238,6 +238,9 @@ Patch62:        perl-5.25.7-Fix-const-correctness-in-hv_func.h.patch
 # in upsream after 5.25.7
 Patch63:        perl-5.24.0-assertion-failure-in-.-or-0-x-0.patch
 
+# Fix a memory leak in IO::Poll, RT#129788, in upstream after 5.25.7
+Patch64:        perl-5.24.0-perl-129788-IO-Poll-fix-memory-leak.patch
+
 # Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
 Patch200:       perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
 
@@ -2927,6 +2930,7 @@ Perl extension for Version Objects
 %patch61 -p1
 %patch62 -p1
 %patch63 -p1
+%patch64 -p1
 %patch200 -p1
 %patch201 -p1
 
@@ -2981,6 +2985,7 @@ perl -x patchlevel.h \
     'Fedora Patch61: Fix assigning split() return values to an array' \
     'Fedora Patch62: Fix const correctness in hv_func.h (RT#130169)' \
     'Fedora Patch63: Fix a crash in optimized evaluation of "or ((0) x 0))" (RT#130247)' \
+    'Fedora Patch64: Fix a memory leak in IO::Poll (RT#129788)' \
     'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
     'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
     %{nil}
@@ -5261,6 +5266,7 @@ popd
 %changelog
 * Mon Dec 19 2016 Petr Pisar <ppisar@redhat.com> - 4:5.24.0-382
 - Fix a crash in optimized evaluation of "or ((0) x 0))" (RT#130247)
+- Fix a memory leak in IO::Poll (RT#129788)
 
 * Thu Dec 01 2016 Petr Pisar <ppisar@redhat.com> - 4:5.24.0-381
 - Fix crash in Storable when deserializing malformed code reference