diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm index d2205acd5aa5..c3e8220e3297 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm @@ -11,7 +11,7 @@ use Symbol; our $VERSION; BEGIN { - $VERSION = '3.43'; + $VERSION = '3.44'; require ExtUtils::ParseXS::Constants; ExtUtils::ParseXS::Constants->VERSION($VERSION); require ExtUtils::ParseXS::CountLines; ExtUtils::ParseXS::CountLines->VERSION($VERSION); require ExtUtils::ParseXS::Utilities; ExtUtils::ParseXS::Utilities->VERSION($VERSION); @@ -690,10 +690,17 @@ EOF do_push => undef, } ) for grep $self->{in_out}->{$_} =~ /OUT$/, sort keys %{ $self->{in_out} }; - my $prepush_done; + my $outlist_count = @{ $outlist_ref }; + if ($outlist_count) { + my $ext = $outlist_count; + ++$ext if $self->{gotRETVAL} || $wantRETVAL; + print "\tXSprePUSH;"; + print "\tEXTEND(SP,$ext);\n"; + } # all OUTPUT done, so now push the return value on the stack if ($self->{gotRETVAL} && $self->{RETVAL_code}) { print "\t$self->{RETVAL_code}\n"; + print "\t++SP;\n" if $outlist_count; } elsif ($self->{gotRETVAL} || $wantRETVAL) { my $outputmap = $self->{typemap}->get_outputmap( ctype => $self->{ret_type} ); @@ -708,8 +715,9 @@ EOF ); if (not $trgt->{with_size} and $trgt->{type} eq 'p') { # sv_setpv # PUSHp corresponds to sv_setpvn. Treat sv_setpv directly - print "\tsv_setpv(TARG, $what); XSprePUSH; PUSHTARG;\n"; - $prepush_done = 1; + print "\tsv_setpv(TARG, $what);\n"; + print "\tXSprePUSH;\n" unless $outlist_count; + print "\tPUSHTARG;\n"; } else { my $tsize = $trgt->{what_size}; @@ -718,8 +726,8 @@ EOF qq("$tsize"), {var => $var, type => $self->{ret_type}} ); - print "\tXSprePUSH; PUSH$trgt->{type}($what$tsize);\n"; - $prepush_done = 1; + print "\tXSprePUSH;\n" unless $outlist_count; + print "\tPUSH$trgt->{type}($what$tsize);\n"; } } else { @@ -731,15 +739,13 @@ EOF do_setmagic => 0, do_push => undef, } ); + print "\t++SP;\n" if $outlist_count; } } $xsreturn = 1 if $self->{ret_type} ne "void"; my $num = $xsreturn; - my $c = @{ $outlist_ref }; - print "\tXSprePUSH;" if $c and not $prepush_done; - print "\tEXTEND(SP,$c);\n" if $c; - $xsreturn += $c; + $xsreturn += $outlist_count; $self->generate_output( { type => $self->{var_types}->{$_}, num => $num++, diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm index d7668c4733de..5b73795d0371 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm @@ -3,7 +3,7 @@ use strict; use warnings; use Symbol; -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm index c592621e0307..a5b71f6b9f2a 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm @@ -1,7 +1,7 @@ package ExtUtils::ParseXS::CountLines; use strict; -our $VERSION = '3.43'; +our $VERSION = '3.44'; our $SECTION_END_MARKER; diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm index c509531d2f2a..8a3bd00deea4 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm @@ -2,7 +2,7 @@ package ExtUtils::ParseXS::Eval; use strict; use warnings; -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm index 6cc8a0e40853..574031d15750 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm @@ -5,7 +5,7 @@ use Exporter; use File::Spec; use ExtUtils::ParseXS::Constants (); -our $VERSION = '3.43'; +our $VERSION = '3.44'; our (@ISA, @EXPORT_OK); @ISA = qw(Exporter); diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm index 62a2b1b606e1..c6d5430ff7a0 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.43'; +our $VERSION = '3.44'; require ExtUtils::ParseXS; require ExtUtils::ParseXS::Constants; diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm index 5bddcc0569d8..3c4b4e519ce8 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Cmd.pm @@ -2,7 +2,7 @@ package ExtUtils::Typemaps::Cmd; use 5.006001; use strict; use warnings; -our $VERSION = '3.43'; +our $VERSION = '3.44'; use ExtUtils::Typemaps; diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm index fd2efc878d2a..102fc9ebfc7c 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/InputMap.pm @@ -2,7 +2,7 @@ package ExtUtils::Typemaps::InputMap; use 5.006001; use strict; use warnings; -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm index d4210c55767c..f9b5a8603562 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/OutputMap.pm @@ -2,7 +2,7 @@ package ExtUtils::Typemaps::OutputMap; use 5.006001; use strict; use warnings; -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm index 36d575339cd5..1a78c17ef9b3 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm @@ -4,7 +4,7 @@ use strict; use warnings; require ExtUtils::Typemaps; -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/t/002-more.t b/dist/ExtUtils-ParseXS/t/002-more.t index 3ea89c2583fe..c8cc7bf97c60 100644 --- a/dist/ExtUtils-ParseXS/t/002-more.t +++ b/dist/ExtUtils-ParseXS/t/002-more.t @@ -9,7 +9,7 @@ use ExtUtils::CBuilder; use attributes; use overload; -plan tests => 30; +plan tests => 32; my ($source_file, $obj_file, $lib_file); @@ -91,6 +91,12 @@ SKIP: { is_deeply [XSMore::outlist()], [ord('a'), ord('b')], 'the OUTLIST keyword'; + is_deeply [XSMore::outlist_bool("a", "b")], [ !0, "ab" ], + "OUTLIST with a bool RETVAL"; + + is_deeply [XSMore::outlist_int("c", "d")], [ 11, "cd" ], + "OUTLIST with an int RETVAL"; + # eval so compile-time sees any prototype is_deeply [ eval 'XSMore::outlist()' ], [ord('a'), ord('b')], 'OUTLIST prototypes'; diff --git a/dist/ExtUtils-ParseXS/t/XSMore.xs b/dist/ExtUtils-ParseXS/t/XSMore.xs index 21ad41df8907..f8413f43bde8 100644 --- a/dist/ExtUtils-ParseXS/t/XSMore.xs +++ b/dist/ExtUtils-ParseXS/t/XSMore.xs @@ -38,6 +38,36 @@ outlist(int* a, int* b){ *b = 'b'; } +STATIC bool +outlist_bool(const char *a, const char *b, char **c) +{ + dTHX; + STRLEN lena = strlen(a); + STRLEN lenb = strlen(b); + STRLEN lenc = lena + lenb; + Newx(*c, lenc+1, char); + strcpy(*c, a); + strcat(*c, b); + SAVEFREEPV(*c); + + return TRUE; +} + +STATIC int +outlist_int(const char *a, const char *b, char **c) +{ + dTHX; + STRLEN lena = strlen(a); + STRLEN lenb = strlen(b); + STRLEN lenc = lena + lenb; + Newx(*c, lenc+1, char); + strcpy(*c, a); + strcat(*c, b); + SAVEFREEPV(*c); + + return 11; +} + STATIC int len(const char* const s, int const l){ PERL_UNUSED_ARG(s); @@ -201,6 +231,12 @@ CLEANUP: void outlist(OUTLIST int a, OUTLIST int b) +bool +outlist_bool(const char *a, const char *b, OUTLIST char *c) + +int +outlist_int(const char *a, const char *b, OUTLIST char *c) + int len(char* s, int length(s)) diff --git a/ext/XS-Typemap/Typemap.pm b/ext/XS-Typemap/Typemap.pm index 9f838b44cb6c..3a4ee1cc3c0d 100644 --- a/ext/XS-Typemap/Typemap.pm +++ b/ext/XS-Typemap/Typemap.pm @@ -34,18 +34,23 @@ to the test script. use parent qw/ Exporter /; require XSLoader; -our $VERSION = '0.18'; +our $VERSION = '0.19'; our @EXPORT = (qw/ T_SV + T_SV_output T_SVREF T_SVREF_REFCOUNT_FIXED + T_SVREF_REFCOUNT_FIXED_output T_AVREF T_AVREF_REFCOUNT_FIXED + T_AVREF_REFCOUNT_FIXED_output T_HVREF T_HVREF_REFCOUNT_FIXED + T_HVREF_REFCOUNT_FIXED_output T_CVREF T_CVREF_REFCOUNT_FIXED + T_CVREF_REFCOUNT_FIXED_output T_SYSRET_fail T_SYSRET_pass T_UV T_IV diff --git a/ext/XS-Typemap/Typemap.xs b/ext/XS-Typemap/Typemap.xs index 397052d1cb5d..9250e3e11082 100644 --- a/ext/XS-Typemap/Typemap.xs +++ b/ext/XS-Typemap/Typemap.xs @@ -267,6 +267,13 @@ T_SV( sv ) OUTPUT: RETVAL +void +T_SV_output(sv) + SV *sv + CODE: + sv = sv_2mortal(newSVpvn("test", 4)); + OUTPUT: + sv ## T_SVREF @@ -290,6 +297,11 @@ T_SVREF_REFCOUNT_FIXED( svref ) OUTPUT: RETVAL +void +T_SVREF_REFCOUNT_FIXED_output( OUT svref ) + SVREF_FIXED svref + CODE: + svref = newSVpvn("test", 4); ## T_AVREF @@ -313,6 +325,12 @@ T_AVREF_REFCOUNT_FIXED( av ) OUTPUT: RETVAL +void +T_AVREF_REFCOUNT_FIXED_output( OUT avref) + AV_FIXED *avref; + CODE: + avref = newAV(); + av_push(avref, newSVpvs("test")); ## T_HVREF @@ -336,6 +354,12 @@ T_HVREF_REFCOUNT_FIXED( hv ) OUTPUT: RETVAL +void +T_HVREF_REFCOUNT_FIXED_output( OUT hvref) + HV_FIXED *hvref; + CODE: + hvref = newHV(); + hv_stores(hvref, "test", newSVpvs("value")); ## T_CVREF @@ -359,6 +383,12 @@ T_CVREF_REFCOUNT_FIXED( cv ) OUTPUT: RETVAL +void +T_CVREF_REFCOUNT_FIXED_output( OUT cvref) + CV_FIXED *cvref; + CODE: + cvref = get_cv("XSLoader::load", 0); + SvREFCNT_inc(cvref); ## T_SYSRET diff --git a/ext/XS-Typemap/t/Typemap.t b/ext/XS-Typemap/t/Typemap.t index 3e56b573d6c9..93a67bf031f4 100644 --- a/ext/XS-Typemap/t/Typemap.t +++ b/ext/XS-Typemap/t/Typemap.t @@ -6,7 +6,7 @@ BEGIN { } } -use Test::More tests => 156; +use Test::More tests => 170; use strict; #catch WARN_INTERNAL type errors, and anything else unexpected @@ -33,6 +33,10 @@ note("T_SV"); my $sv = "Testing T_SV"; is( T_SV($sv), $sv); +# T_SV with output +is_deeply([ T_SV_output($sv) ], [], "T_SV_output: no return value"); +is($sv, "test", "T_SV_output: output written to"); + # T_SVREF - reference to Scalar note("T_SVREF"); $sv .= "REF"; @@ -51,6 +55,14 @@ is( ${ T_SVREF_REFCOUNT_FIXED($svref) }, $$svref ); eval { T_SVREF_REFCOUNT_FIXED( "fail - not ref" ) }; ok( $@ ); +# output only +SKIP:{ + my $svr; + is_deeply([ T_SVREF_REFCOUNT_FIXED_output($svr) ], [ ], "call with non-ref lvalue, no return value"); + ok(ref $svr, "output parameter now a reference") + or skip "Not a reference", 1; + is($$svr, "test", "reference to correct value"); +} # T_AVREF - reference to a perl Array note("T_AVREF"); @@ -67,6 +79,14 @@ is( T_AVREF_REFCOUNT_FIXED(\@array), \@array); eval { T_AVREF_REFCOUNT_FIXED( \$sv ) }; ok( $@ ); +# output only +SKIP:{ + my $avr; + is_deeply([ T_AVREF_REFCOUNT_FIXED_output($avr) ], [ ], "call with non-ref lvalue, no return value"); + ok(ref $avr, "output parameter now a reference") + or skip "Not a reference", 1; + is_deeply($avr, [ "test" ], "has expected entry"); +} # T_HVREF - reference to a perl Hash note("T_HVREF"); @@ -84,6 +104,14 @@ is( T_HVREF_REFCOUNT_FIXED(\%hash), \%hash); eval { T_HVREF_REFCOUNT_FIXED( \@array ) }; ok( $@ ); +# output only +SKIP:{ + my $hvr; + is_deeply([ T_HVREF_REFCOUNT_FIXED_output($hvr) ], [ ], "call with non-ref lvalue, no return value"); + ok(ref $hvr, "output parameter now a reference") + or skip "Not a reference", 1; + is($hvr->{test}, "value", "has expected key"); +} # T_CVREF - reference to perl subroutine note("T_CVREF"); @@ -98,6 +126,14 @@ is( T_CVREF_REFCOUNT_FIXED($sub), $sub ); eval { T_CVREF_REFCOUNT_FIXED( \@array ) }; ok( $@ ); +# output only +SKIP:{ + my $cvr; + is_deeply([ T_CVREF_REFCOUNT_FIXED_output($cvr) ], [ ], "call with non-ref lvalue, no return value"); + ok(ref $cvr, "output parameter now a reference") + or skip "Not a reference", 1; + is($cvr, \&XSLoader::load, "ref to expected sub"); +} # T_SYSRET - system return values note("T_SYSRET"); diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap index 8aa1e12135ec..a07e83f9012a 100644 --- a/lib/ExtUtils/typemap +++ b/lib/ExtUtils/typemap @@ -315,23 +315,23 @@ T_OUT ############################################################################# OUTPUT T_SV - $arg = $var; + ${ "$var" eq "RETVAL" ? \"$arg = $var;" : \"sv_setsv_mg($arg, $var);" } T_SVREF $arg = newRV((SV*)$var); T_SVREF_REFCOUNT_FIXED - $arg = newRV_noinc((SV*)$var); + ${ "$var" eq "RETVAL" ? \"$arg = newRV_noinc((SV*)$var);" : \"sv_setrv_noinc($arg, (SV*)$var);" } T_AVREF $arg = newRV((SV*)$var); T_AVREF_REFCOUNT_FIXED - $arg = newRV_noinc((SV*)$var); + ${ "$var" eq "RETVAL" ? \"$arg = newRV_noinc((SV*)$var);" : \"sv_setrv_noinc($arg, (SV*)$var);" } T_HVREF $arg = newRV((SV*)$var); T_HVREF_REFCOUNT_FIXED - $arg = newRV_noinc((SV*)$var); + ${ "$var" eq "RETVAL" ? \"$arg = newRV_noinc((SV*)$var);" : \"sv_setrv_noinc($arg, (SV*)$var);" } T_CVREF $arg = newRV((SV*)$var); T_CVREF_REFCOUNT_FIXED - $arg = newRV_noinc((SV*)$var); + ${ "$var" eq "RETVAL" ? \"$arg = newRV_noinc((SV*)$var);" : \"sv_setrv_noinc($arg, (SV*)$var);" } T_IV sv_setiv($arg, (IV)$var); T_UV