diff --git a/ext/XS-Typemap/Typemap.pm b/ext/XS-Typemap/Typemap.pm index de3319b05945..a1ae0211d2ac 100644 --- a/ext/XS-Typemap/Typemap.pm +++ b/ext/XS-Typemap/Typemap.pm @@ -36,7 +36,7 @@ require XSLoader; use vars qw/ $VERSION @EXPORT /; -$VERSION = '0.13'; +$VERSION = '0.14'; @EXPORT = (qw/ T_SV @@ -76,7 +76,7 @@ $VERSION = '0.13'; T_OPAQUEPTR_IN T_OPAQUEPTR_OUT T_OPAQUEPTR_OUT_short T_OPAQUEPTR_IN_struct T_OPAQUEPTR_OUT_struct T_ARRAY - T_STDIO_open T_STDIO_close T_STDIO_print + T_STDIO_open T_STDIO_open_ret_in_arg T_STDIO_close T_STDIO_print T_PACKED_in T_PACKED_out T_PACKEDARRAY_in T_PACKEDARRAY_out T_INOUT T_IN T_OUT diff --git a/ext/XS-Typemap/Typemap.xs b/ext/XS-Typemap/Typemap.xs index 3fa0e74abc75..8314cc2b04bc 100644 --- a/ext/XS-Typemap/Typemap.xs +++ b/ext/XS-Typemap/Typemap.xs @@ -906,6 +906,15 @@ T_STDIO_open( file ) OUTPUT: RETVAL +void +T_STDIO_open_ret_in_arg( file, io) + const char * file + FILE * io = NO_INIT + CODE: + io = xsfopen( file ); + OUTPUT: + io + SysRet T_STDIO_close( f ) PerlIO * f diff --git a/ext/XS-Typemap/t/Typemap.t b/ext/XS-Typemap/t/Typemap.t index 27b40860fdf2..49ac479884b8 100644 --- a/ext/XS-Typemap/t/Typemap.t +++ b/ext/XS-Typemap/t/Typemap.t @@ -6,10 +6,11 @@ BEGIN { } } -use Test::More tests => 152; +use Test::More tests => 156; use strict; -use warnings; +#catch WARN_INTERNAL type errors, and anything else unexpected +use warnings FATAL => 'all'; use XS::Typemap; pass(); @@ -213,6 +214,7 @@ is( T_PV("a string"), "a string"); is( T_PV(52), 52); ok !defined T_PV_null, 'RETVAL = NULL returns undef for char*'; { + use warnings NONFATAL => 'all'; my $uninit; local $SIG{__WARN__} = sub { ++$uninit if shift =~ /uninit/ }; () = ''.T_PV_null; @@ -393,6 +395,16 @@ if (defined $fh) { } } +$fh = "FOO"; +T_STDIO_open_ret_in_arg( $testfile, $fh); +ok( $fh ne "FOO", 'return io in arg open succeeds'); +ok( print($fh "first line\n"), 'can print to return io in arg'); +ok( close($fh), 'can close return io in arg'); +$fh = "FOO"; +#now with a bad file name to make sure $fh is written to on failure +T_STDIO_open_ret_in_arg( "", $fh); +ok( !defined$fh, 'return io in arg open failed successfully'); + # T_INOUT note("T_INOUT"); SCOPE: { @@ -439,6 +451,10 @@ SCOPE: { ok(!close $fh2); } +# Perl RT #124181 SEGV due to double free in typemap +# "Attempt to free unreferenced scalar" +%{*{main::XS::}{HASH}} = (); + sub is_approx { my ($l, $r, $n) = @_; if (not defined $l or not defined $r) {