$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-nooptimize] [-noinout] [-noargtypes] [-s pattern] [-typemap typemap]... file.xs\n";
-$proto_re = "[" . quotemeta('\$%&*@;') . "]" ;
-# mjn
-$OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i;
+$proto_re = "[" . quotemeta('\$%&*@;[]') . "]" ;
$except = "";
$WantPrototypes = -1 ;
$WantVersionChk = 0, next SWITCH if $flag eq 'noversioncheck';
$WantVersionChk = 1, next SWITCH if $flag eq 'versioncheck';
# XXX left this in for compat
- $WantCAPI = 1, next SWITCH if $flag eq 'object_capi';
+ next SWITCH if $flag eq 'object_capi';
$except = " TRY", next SWITCH if $flag eq 'except';
push(@tm,shift), next SWITCH if $flag eq 'typemap';
$WantLineNumbers = 0, next SWITCH if $flag eq 'nolinenumbers';
../../lib/ExtUtils/typemap ../../../typemap ../../typemap
../typemap typemap);
foreach $typemap (@tm) {
- next unless -e $typemap ;
+ next unless -f $typemap ;
# skip directories, binary files etc.
warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
unless -T $typemap ;
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
last if ($Module, $Package, $Prefix) =
/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
- if ($OBJ) {
- s/#if(?:def\s|\s+defined)\s*(\(__cplusplus\)|__cplusplus)/#if defined(__cplusplus) && !defined(PERL_OBJECT)/;
- }
print $_;
}
&Exit unless defined $_;
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
# 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
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 $@;
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 ;
#
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;
$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 {