From 8f12141844ee46cc086c5d513deaef76f51b6d9a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppi...@redhat.com>
Date: Mon, 19 Dec 2016 12:52:35 +0100
Subject: Fix a memory leak in IO::Poll
---
....24.0-perl-129788-IO-Poll-fix-memory-leak.patch | 134 +++++++++++++++++++++
perl.spec | 6 +
2 files changed, 140 insertions(+)
create mode 100644 perl-5.24.0-perl-129788-IO-Poll-fix-memory-leak.patch
diff --git a/perl-5.24.0-perl-129788-IO-Poll-fix-memory-leak.patch
b/perl-5.24.0-perl-129788-IO-Poll-fix-memory-leak.patch
new file mode 100644
index 0000000..aa6f20f
--- /dev/null
+++ b/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 <t...@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 <t...@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.aleyni...@gmail.com>
+
+Signed-off-by: Petr Písař <ppi...@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
+
diff --git a/perl.spec b/perl.spec
index bf7fb2e..0fbfe77 100644
--- a/perl.spec
+++ b/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
@@ -2925,6 +2928,7 @@ Perl extension for Version Objects
%patch61 -p1
%patch62 -p1
%patch63 -p1
+%patch64 -p1
%patch200 -p1
%patch201 -p1
@@ -2979,6 +2983,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}
@@ -5265,6 +5270,7 @@ popd
- Fix assigning split() return values to an array
- Fix const correctness in hv_func.h (bug #1242980)
- Fix a crash in optimized evaluation of "or ((0) x 0))" (RT#130247)
+- Fix a memory leak in IO::Poll (RT#129788)
* Wed Nov 09 2016 Petr Pisar <ppi...@redhat.com> - 4:5.24.0-379
- Tie perl-Errno release to interpreter build because of kernel version check
--
cgit v0.12
http://pkgs.fedoraproject.org/cgit/perl.git/commit/?h=f25&id=8f12141844ee46cc086c5d513deaef76f51b6d9a
_______________________________________________
perl-devel mailing list -- perl-devel@lists.fedoraproject.org
To unsubscribe send an email to perl-devel-le...@lists.fedoraproject.org
