In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/244d26825825c6a1d5bc181e6da699d48bcb51a4?hp=b5145c7d479fcfcb104fc6d3d89b4d757ca3cd15>
- Log -----------------------------------------------------------------
commit 244d26825825c6a1d5bc181e6da699d48bcb51a4
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Dec 10 17:13:17 2017 -0800
perldelta for #115814
db9848c8d3fb and 6da090e6cb.
commit 76eb84800b51f32ecd4ab68d15ca549f2f67721b
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Dec 10 16:54:44 2017 -0800
Increase $ExtUtils::Typemaps::VERSION to 3.37
commit 732d3893ab63739910640c98c1cc83ab7bb1332c
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Dec 10 16:53:45 2017 -0800
Avoid newGVgen in blead-upstream modules
ExtUtils::ParseXS::Typemaps:
Just in documentation, but it’s good to change it, in case peo-
ple copy it.
Time::HiRes:
It doesn’t even use these typemap entries, but I changed it in case
they get used in the future. (The changes are not identical to the
default typemap, because Time::HiRes is 5.6-compatible, at least
nominally.)
os2/os2.c:
No, this is not a module, but I changed it, too.
Some other instances of newGVgen are already handled properly, or are
just in tests, so I left them alone.
commit 6da090e6cb9d18c5db3bb70c8c4d0c7e58183273
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Dec 10 16:37:11 2017 -0800
Avoid newGVgen in default typemap
newGVgen leaks memory, because it puts it vivifies a typeglob in the
symbol table, without arranging for it to be deleted. A typemap is not
an appropriate place to use it, since callers of newGVgen are responsible
for seeing that the GV is freed, if they care.
This came up in #115814.
commit 463029d782557372dfee8afb1aa234047cc01247
Author: Father Chrysostomos <spr...@cpan.org>
Date: Sun Dec 10 16:33:22 2017 -0800
perlapio: wrong param type
-----------------------------------------------------------------------
Summary of changes:
dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm | 6 ++++--
dist/Time-HiRes/typemap | 12 ++++++++----
ext/XS-APItest/APItest.xs | 14 ++++++++++++++
lib/ExtUtils/typemap | 12 ++++++++----
os2/os2.c | 3 ++-
pod/perlapio.pod | 2 +-
pod/perldelta.pod | 10 ++++++++++
t/op/svleak.t | 8 +++++++-
8 files changed, 54 insertions(+), 13 deletions(-)
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
index d7a219e7fd..eae1190d1f 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps;
use 5.006001;
use strict;
use warnings;
-our $VERSION = '3.36';
+our $VERSION = '3.37';
require ExtUtils::ParseXS;
require ExtUtils::ParseXS::Constants;
@@ -781,7 +781,9 @@ corresponding OUTPUT code:
$var.context.value().size());
',
'T_OUT' => ' {
- GV *gv = newGVgen("$Package");
+ GV *gv = (GV *)sv_newmortal();
+ gv_init_pvn(gv, gv_stashpvs("$Package",1),
+ "__ANONIO__",10,0);
if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
sv_setsv(
$arg,
diff --git a/dist/Time-HiRes/typemap b/dist/Time-HiRes/typemap
index 3fa91f3a0b..768e56a4f5 100644
--- a/dist/Time-HiRes/typemap
+++ b/dist/Time-HiRes/typemap
@@ -282,7 +282,8 @@ T_ARRAY
}
T_STDIO
{
- GV *gv = newGVgen("$Package");
+ GV *gv = (GV *)sv_newmortal();
+ gv_init(gv, gv_stashpv("$Package",1),"__ANONIO__",10,0);
PerlIO *fp = PerlIO_importFILE($var,0);
if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) )
sv_setsv($arg, sv_bless(newRV((SV*)gv),
gv_stashpv("$Package",1)));
@@ -291,7 +292,8 @@ T_STDIO
}
T_IN
{
- GV *gv = newGVgen("$Package");
+ GV *gv = (GV *)sv_newmortal();
+ gv_init(gv, gv_stashpv("$Package",1),"__ANONIO__",10,0);
if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
sv_setsv($arg, sv_bless(newRV((SV*)gv),
gv_stashpv("$Package",1)));
else
@@ -299,7 +301,8 @@ T_IN
}
T_INOUT
{
- GV *gv = newGVgen("$Package");
+ GV *gv = (GV *)sv_newmortal();
+ gv_init(gv, gv_stashpv("$Package",1),"__ANONIO__",10,0);
if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
sv_setsv($arg, sv_bless(newRV((SV*)gv),
gv_stashpv("$Package",1)));
else
@@ -307,7 +310,8 @@ T_INOUT
}
T_OUT
{
- GV *gv = newGVgen("$Package");
+ GV *gv = (GV *)sv_newmortal();
+ gv_init(gv, gv_stashpv("$Package",1),"__ANONIO__",10,0);
if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
sv_setsv($arg, sv_bless(newRV((SV*)gv),
gv_stashpv("$Package",1)));
else
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index d4adcdb5ab..5dec99eb6b 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -13,6 +13,8 @@
typedef SV *SVREF;
typedef PTR_TBL_t *XS__APItest__PtrTable;
+typedef PerlIO * InputStream;
+typedef PerlIO * OutputStream;
#define croak_fail() croak("fail at " __FILE__ " line %d", __LINE__)
#define croak_fail_nep(h, w) croak("fail %p!=%p at " __FILE__ " line %d", (h),
(w), __LINE__)
@@ -4302,6 +4304,18 @@ get_cv_flags(SV *sv, UV flags)
OUTPUT:
RETVAL
+PerlIO *
+PerlIO_stderr()
+
+OutputStream
+PerlIO_stdout()
+
+InputStream
+PerlIO_stdin()
+
+FILE *
+PerlIO_exportFILE(PerlIO *f, const char *mode)
+
MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
int
diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap
index 4bfba95e9e..ca923cf67b 100644
--- a/lib/ExtUtils/typemap
+++ b/lib/ExtUtils/typemap
@@ -398,7 +398,8 @@ T_ARRAY
}
T_STDIO
{
- GV *gv = newGVgen("$Package");
+ GV *gv = (GV *)sv_newmortal();
+ gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);
PerlIO *fp = PerlIO_importFILE($var,0);
if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) ) {
SV *rv = newRV_inc((SV*)gv);
@@ -411,7 +412,8 @@ T_STDIO
}
T_IN
{
- GV *gv = newGVgen("$Package");
+ GV *gv = (GV *)sv_newmortal();
+ gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);
if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) ) {
SV *rv = newRV_inc((SV*)gv);
rv = sv_bless(rv, GvSTASH(gv));
@@ -423,7 +425,8 @@ T_IN
}
T_INOUT
{
- GV *gv = newGVgen("$Package");
+ GV *gv = (GV *)sv_newmortal();
+ gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);
if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) {
SV *rv = newRV_inc((SV*)gv);
rv = sv_bless(rv, GvSTASH(gv));
@@ -435,7 +438,8 @@ T_INOUT
}
T_OUT
{
- GV *gv = newGVgen("$Package");
+ GV *gv = (GV *)sv_newmortal();
+ gv_init_pvn(gv, gv_stashpvs("$Package",1),"__ANONIO__",10,0);
if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) ) {
SV *rv = newRV_inc((SV*)gv);
rv = sv_bless(rv, GvSTASH(gv));
diff --git a/os2/os2.c b/os2/os2.c
index 20572f0acb..66f387bd3c 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -4257,7 +4257,8 @@ XS(XS_OS2_pipe)
perlio = PerlIO_fdopen(hpipe, buf);
ST(0) = sv_newmortal();
{
- GV *gv = newGVgen("OS2::pipe");
+ GV *gv = (GV *)sv_newmortal();
+ gv_init_pvn(gv, gv_stashpvs("OS2::pipe",1),"__ANONIO__",10,0);
if ( do_open6(gv, perltype, strlen(perltype), perlio, NULL, 0) )
sv_setsv(ST(0), sv_bless(newRV((SV*)gv),
gv_stashpv("IO::Handle",1)));
else
diff --git a/pod/perlapio.pod b/pod/perlapio.pod
index 5682e95cfd..c32da9606b 100644
--- a/pod/perlapio.pod
+++ b/pod/perlapio.pod
@@ -58,7 +58,7 @@ perlapio - perl's IO abstraction interface.
SSize_t PerlIO_get_bufsiz(PerlIO *f);
PerlIO *PerlIO_importFILE(FILE *stdio, const char *mode);
- FILE *PerlIO_exportFILE(PerlIO *f, int flags);
+ FILE *PerlIO_exportFILE(PerlIO *f, const char *mode);
FILE *PerlIO_findFILE(PerlIO *f);
void PerlIO_releaseFILE(PerlIO *f,FILE *stdio);
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 5cf9d5e3fc..7ef8c7fff8 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -401,6 +401,16 @@ XXX
Perl's own C<malloc> no longer gets confused by attempts to allocate
more than a gigabyte on a 64-bit platform. [perl #119829]
+=item *
+
+C<open $$scalarref...> and similar invocations no longer leak the file
+handle. [perl #115814]
+
+=item *
+
+The default typemap, by avoiding C<newGVgen>, now no longer leaks when
+XSUBs return file handles (C<PerlIO *> or C<FILE *>). [perl #115814]
+
=back
=head1 Known Problems
diff --git a/t/op/svleak.t b/t/op/svleak.t
index 7226dd878c..b07e3f8e99 100644
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
use Config;
-plan tests => 142;
+plan tests => 146;
# run some code N times. If the number of SVs at the end of loop N is
# greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -598,3 +598,9 @@ EOF
sub N_leak { eval 'tr//\N{}-0/' }
::leak(2, 0, \&N_leak, "a bad \\N{} in a range leaks");
}
+
+leak 2,0,\&XS::APItest::PerlIO_stderr,'T_INOUT in default typemap';
+leak 2,0,\&XS::APItest::PerlIO_stdin, 'T_IN in default typemap';
+leak 2,0,\&XS::APItest::PerlIO_stdout,'T_OUT in default typemap';
+leak 2,1,sub{XS::APItest::PerlIO_exportFILE(*STDIN,"");0},
+ 'T_STDIO in default typemap';
--
Perl5 Master Repository
