Fix OUTLIST handling for EU::ParseXS, and typemap fixes

16 files changed, 146 insertions, 27 deletions

diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
index d2205acd5a..c3e8220e32 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 d7668c4733..5b73795d03 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 c592621e03..a5b71f6b9f 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 c509531d2f..8a3bd00dee 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 6cc8a0e408..574031d157 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 62a2b1b606..c6d5430ff7 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 5bddcc0569..3c4b4e519c 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 fd2efc878d..102fc9ebfc 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 d4210c5576..f9b5a86035 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 36d575339c..1a78c17ef9 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 3ea89c2583..c8cc7bf97c 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 21ad41df89..f8413f43bd 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 9f838b44cb..3a4ee1cc3c 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 397052d1cb..9250e3e110 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 3e56b573d6..93a67bf031 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 8aa1e12135..a07e83f901 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