In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/906138908fccbd2b1d67430c2437155f0fa8e5c2?hp=35ffb081a8fa691dd8ceff9c56d5d00b3ef81b96>
- Log ----------------------------------------------------------------- commit 906138908fccbd2b1d67430c2437155f0fa8e5c2 Author: David Mitchell <[email protected]> Date: Fri Dec 12 19:52:53 2014 +0000 XS-Typemap/t/Typemap.t: avoid close warnings This test creates some file handles and dups them using XS that exercises the T_OUT etc typemaps. When the dup filehandle is implicitly closed on scope exit, it warns, since the close fails: Warning: unable to close filehandle properly: Bad file descriptor The close fails because the two file handles are sharing the same underlying IoIFP/IoOFP and so the second of the two closes doesn't work. Fix this by explicitly closing the handles. (Note that until the previous commit that fixed a leak with these typemaps, the warning wasn't coming until global destruction, since the new GV was being leaked.) M ext/XS-Typemap/t/Typemap.t commit 50e5165b9638b94be310f15477b42935c79e82d5 Author: David Mitchell <[email protected]> Date: Fri Dec 12 19:52:22 2014 +0000 stop T_IN/OUT/INOUT/STDIO typemaps leaking These typemaps (which are ancient; mostly going back to 1994 or so) each leaked a GV and an RV. M lib/ExtUtils/typemap ----------------------------------------------------------------------- Summary of changes: ext/XS-Typemap/t/Typemap.t | 8 +++++++- lib/ExtUtils/typemap | 32 ++++++++++++++++++++++++-------- 2 files changed, 31 insertions(+), 9 deletions(-) diff --git a/ext/XS-Typemap/t/Typemap.t b/ext/XS-Typemap/t/Typemap.t index e251c55..27b4086 100644 --- a/ext/XS-Typemap/t/Typemap.t +++ b/ext/XS-Typemap/t/Typemap.t @@ -6,7 +6,7 @@ BEGIN { } } -use Test::More tests => 148; +use Test::More tests => 152; use strict; use warnings; @@ -405,6 +405,9 @@ SCOPE: { seek($fh2, 0, 0); is(readline($fh2), $str); ok(print $fh2 "foo\n"); + ok(close $fh); + # this fails because the underlying shared handle is already closed + ok(!close $fh2); } # T_IN @@ -431,6 +434,9 @@ SCOPE: { seek($fh2, 0, 0); is(readline($fh2), $str); ok(eval {print $fh2 "foo\n"; 1}); + ok(close $fh); + # this fails because the underlying shared handle is already closed + ok(!close $fh2); } sub is_approx { diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap index 0b09641..831baad 100644 --- a/lib/ExtUtils/typemap +++ b/lib/ExtUtils/typemap @@ -388,32 +388,48 @@ T_STDIO { GV *gv = newGVgen("$Package"); 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))); + if ( fp && do_open(gv, "+<&", 3, FALSE, 0, 0, fp) ) { + SV *rv = newRV_noinc((SV*)gv); + rv = sv_bless(rv, gv_stashpv("$Package",1)); + sv_setsv($arg, rv); + SvREFCNT_dec_NN(rv); + } else $arg = &PL_sv_undef; } T_IN { GV *gv = newGVgen("$Package"); - if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) ) - sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); + if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) ) { + SV *rv = newRV_noinc((SV*)gv); + rv = sv_bless(rv, gv_stashpv("$Package",1)); + sv_setsv($arg, rv); + SvREFCNT_dec_NN(rv); + } else $arg = &PL_sv_undef; } T_INOUT { GV *gv = newGVgen("$Package"); - if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) - sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); + if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) { + SV *rv = newRV_noinc((SV*)gv); + rv = sv_bless(rv, gv_stashpv("$Package",1)); + sv_setsv($arg, rv); + SvREFCNT_dec_NN(rv); + } else $arg = &PL_sv_undef; } T_OUT { GV *gv = newGVgen("$Package"); - if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) ) - sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); + if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) ) { + SV *rv = newRV_noinc((SV*)gv); + rv = sv_bless(rv, gv_stashpv("$Package",1)); + sv_setsv($arg, rv); + SvREFCNT_dec_NN(rv); + } else $arg = &PL_sv_undef; } -- Perl5 Master Repository
