Fixing extra -I's with PERL_CORE
[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / xsubpp
index 0f3d1e6..bc4d6ae 100755 (executable)
@@ -274,7 +274,7 @@ foreach $key (keys %output_expr) {
 
     my ($t, $with_size, $arg, $sarg) =
       ($output_expr{$key} =~
-        m[^ \s+ sv_set ( [iunp] | ref_[iunp] ) v (n)?  # Type, is_setpvn
+        m[^ \s+ sv_set ( [iunp] ) v (n)?       # Type, is_setpvn
             \s* \( \s* $cast \$arg \s* ,
             \s* ( (??{ $bal }) )               # Set from
             ( (??{ $size }) )?                 # Possible sizeof set-from
@@ -996,7 +996,7 @@ while (fetch_para()) {
 
     death ("Code is not inside a function"
           ." (maybe last function was ended by a blank line "
-          ." followed by a a statement on column one?)")
+          ." followed by a statement on column one?)")
        if $line[0] =~ /^\s/;
 
     # initialize info arrays
@@ -1220,6 +1220,15 @@ EOF
 #      Perl_croak(aTHX_ "Usage: $pname($report_args)");
 EOF
 
+    #gcc -Wall: if an xsub has no arguments and PPCODE is used
+    #it is likely none of ST, XSRETURN or XSprePUSH macros are used
+    #hence `ax' (setup by dXSARGS) is unused
+    #XXX: could breakup the dXSARGS; into dSP;dMARK;dITEMS
+    #but such a move could break third-party extensions
+    print Q<<"EOF" if $PPCODE and $num_args == 0;
+#   PERL_UNUSED_VAR(ax); /* -Wall */
+EOF
+
     print Q<<"EOF" if $PPCODE;
 #    SP -= items;
 EOF
@@ -1354,18 +1363,6 @@ EOF
                print "\tsv_setpv(TARG, $what); XSprePUSH; PUSHTARG;\n";
                $prepush_done = 1;
            }
-           elsif ($t and $t->[0] =~ /^ref_/) {
-               local $ntype = $ret_type;
-               my $what = eval qq("$t->[2]");
-               warn $@ if $@;
-               my $size = $t->[3];
-               $size = '' unless defined $size;
-               $size = eval qq("$size");
-               my $n = $t->[1] || '';
-               warn $@ if $@;
-               print "\tXSprePUSH; sv_set$t->[0]v$n(TARG, $what$size); PUSHTARG;\n";
-               $prepush_done = 1;
-           }
            elsif ($t) {
                my $what = eval qq("$t->[2]");
                warn $@ if $@;
@@ -1522,10 +1519,16 @@ EOF
 print Q<<"EOF";
 #[[
 #    dXSARGS;
+EOF
+
+#-Wall: if there is no $Full_func_name there are no xsubs in this .xs
+#so `file' is unused
+print Q<<"EOF" if $Full_func_name;
 #    char* file = __FILE__;
-#
 EOF
 
+print Q "#\n";
+
 print Q<<"EOF" if $WantVersionChk ;
 #    XS_VERSION_BOOTCHECK ;
 #
@@ -1633,6 +1636,7 @@ sub generate_init {
         blurt("Error: No INPUT definition for type '$subtype', typekind '$type_kind{$subtype}' found"), return
             unless defined $input_expr{$type_kind{$subtype}} ;
        $subexpr = $input_expr{$type_kind{$subtype}};
+        $subexpr =~ s/\$type/\$subtype/g;
        $subexpr =~ s/ntype/subtype/g;
        $subexpr =~ s/\$arg/ST(ix_$var)/g;
        $subexpr =~ s/\n\t/\n\t\t/g;
@@ -1683,6 +1687,7 @@ sub generate_output {
 
     $type = TidyType($type) ;
     if ($type =~ /^array\(([^,]*),(.*)\)/) {
+            print "\t$arg = sv_newmortal();\n";
            print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1));\n";
            print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
     } else {