use Config;
use File::Basename;
use File::Spec;
+use Symbol;
require Exporter;
my($XSS_work_idx, $cpp_next_tmp);
use vars qw($VERSION);
-$VERSION = '2.09_01';
-$VERSION = eval $VERSION;
+$VERSION = '2.18';
use vars qw(%input_expr %output_expr $ProtoUsed @InitFileCode $FH $proto_re $Overload $errors $Fallback
$cplusplus $hiertype $WantPrototypes $WantVersionChk $except $WantLineNumbers
argtypes => 1,
typemap => [],
output => \*STDOUT,
+ csuffix => '.c',
%args,
);
@XSStack = ({type => 'none'});
($XSS_work_idx, $cpp_next_tmp) = (0, "XSubPPtmpAAAA");
@InitFileCode = ();
- $FH = 'File0000' ;
+ $FH = Symbol::gensym();
$proto_re = "[" . quotemeta('\$%&*@;[]') . "]" ;
$Overload = 0;
$errors = 0;
chdir($dir);
my $pwd = cwd();
+ my $csuffix = $args{csuffix};
if ($WantLineNumbers) {
my $cfile;
$cfile = $args{outfile};
} else {
$cfile = $args{filename};
- $cfile =~ s/\.xs$/.c/i or $cfile .= ".c";
+ $cfile =~ s/\.xs$/$csuffix/i or $cfile .= $csuffix;
}
tie(*PSEUDO_STDOUT, 'ExtUtils::ParseXS::CountLines', $cfile, $args{output});
select PSEUDO_STDOUT;
$input_expr{$key} =~ s/;*\s+\z//;
}
- my ($bal, $cast, $size);
- $bal = qr[(?:(?>[^()]+)|\((??{ $bal })\))*]; # ()-balanced
+ my ($cast, $size);
+ our $bal = qr[(?:(?>[^()]+)|\((??{ $bal })\))*]; # ()-balanced
$cast = qr[(?:\(\s*SV\s*\*\s*\)\s*)?]; # Optional (SV*) cast
$size = qr[,\s* (??{ $bal }) ]x; # Third arg (to setpvn)
foreach my $key (keys %output_expr) {
- use re 'eval';
+ BEGIN { $^H |= 0x00200000 }; # Equivalent to: use re 'eval', but hardcoded so we can compile re.xs
my ($t, $with_size, $arg, $sarg) =
($output_expr{$key} =~
)) . "|$END)\\s*:";
- my ($C_group_rex, $C_arg);
+ our ($C_group_rex, $C_arg);
# Group in C (no support for comments or literals)
$C_group_rex = qr/ [({\[]
(?: (?> [^()\[\]{}]+ ) | (??{ $C_group_rex }) )*
." followed by a statement on column one?)")
if $line[0] =~ /^\s/;
- my ($class, $static, $elipsis, $wantRETVAL, $RETVAL_no_return);
+ my ($class, $externC, $static, $elipsis, $wantRETVAL, $RETVAL_no_return);
my (@fake_INPUT_pre); # For length(s) generated variables
my (@fake_INPUT);
blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH
unless @line ;
- $static = 1 if $ret_type =~ s/^static\s+//;
+ $externC = 1 if $ret_type =~ s/^extern "C"\s+//;
+ $static = 1 if $ret_type =~ s/^static\s+//;
$func_header = shift(@line);
blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH
\b ( \w+ | length\( \s*\w+\s* \) )
\s* $ /x);
next unless defined($pre) && length($pre);
- my $out_type;
+ my $out_type = '';
my $inout_var;
if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\s+//) {
my $type = $1;
$xsreturn = 1 if $EXPLICIT_RETURN;
+ $externC = $externC ? qq[extern "C"] : "";
+
# print function header
print Q(<<"EOF");
+#$externC
#XS(XS_${Full_func_name}); /* prototype to pass -Wmissing-prototypes */
#XS(XS_${Full_func_name})
#[[
+##ifdef dVAR
+# dVAR; dXSARGS;
+##else
# dXSARGS;
+##endif
EOF
print Q(<<"EOF") if $ALIAS ;
# dXSI32;
if ($ALIAS)
{ print Q(<<"EOF") if $cond }
# if ($cond)
-# Perl_croak(aTHX_ "Usage: %s($report_args)", GvNAME(CvGV(cv)));
+# Perl_croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), "$report_args");
EOF
else
{ print Q(<<"EOF") if $cond }
# if ($cond)
-# Perl_croak(aTHX_ "Usage: $pname($report_args)");
+# Perl_croak(aTHX_ "Usage: %s(%s)", "$pname", "$report_args");
EOF
# cv doesn't seem to be used, in most cases unless we go in
print Q(<<"EOF");
#[[
+##ifdef dVAR
+# dVAR; dXSARGS;
+##else
# dXSARGS;
+##endif
EOF
#-Wall: if there is no $Full_func_name there are no xsubs in this .xs
print "\n /* End of Initialisation Section */\n\n" ;
}
+ if ($] >= 5.009) {
+ print <<'EOF';
+ if (PL_unitcheckav)
+ call_list(PL_scopestack_ix, PL_unitcheckav);
+EOF
+ }
+
print Q(<<"EOF");
# XSRETURN_YES;
#]]
chdir($orig_cwd);
select($orig_fh);
untie *PSEUDO_STDOUT if tied *PSEUDO_STDOUT;
+ close $FH;
return 1;
}
TrimWhitespace($in);
foreach (split /[\s,]+/, $in) {
- $Interfaces{$_} = $_;
+ my $name = $_;
+ $name =~ s/^$Prefix//;
+ $Interfaces{$name} = $_;
}
print Q(<<"EOF");
# XSFUNCTION = $interface_macro($ret_type,cv,XSANY.any_dptr);
Line => \@line,
LineNo => \@line_no,
Filename => $filename,
+ Filepathname => $filepathname,
Handle => $FH,
}) ;
- ++ $FH ;
+ $FH = Symbol::gensym();
# open the new file
open ($FH, "$_") or death("Cannot open '$_': $!") ;
#
EOF
- $filename = $_ ;
+ $filepathname = $filename = $_ ;
# Prime the pump by reading the first
# non-blank line
close $FH ;
$FH = $data->{Handle} ;
+ # $filename is the leafname, which for some reason isused for diagnostic
+ # messages, whereas $filepathname is the full pathname, and is used for
+ # #line directives.
$filename = $data->{Filename} ;
+ $filepathname = $data->{Filepathname} ;
$lastline = $data->{LastLine} ;
$lastline_no = $data->{LastLineNo} ;
@line = @{ $data->{Line} } ;