$VERSION = eval $VERSION if $VERSION =~ /_/;
our (
- @InitFileCode, $FH, $proto_re, $Overload, $errors, $Fallback,
- $hiertype, $WantPrototypes, $WantVersionChk, $WantLineNumbers, $filepathname,
- $dir, $filename, %IncludedFiles, %input_expr, %output_expr,
- %type_kind, %proto_letter, $BLOCK_re, $lastline, $lastline_no, $Package,
+ @InitFileCode, $FH,
+ %IncludedFiles, %input_expr, %output_expr,
+ %type_kind, %proto_letter, $Package,
$Prefix, @line, %args_match, %defaults, %var_types, %arg_list, @proto_arg,
$processing_arg_with_types, %argtype_seen, %in_out, %lengthof,
$proto_in_this_xsub, $scope_in_this_xsub, $interface,
my $cpp_next_tmp = 'XSubPPtmpAAAA';
@InitFileCode = @ExtUtils::ParseXS::Constants::InitFileCode;
$FH = $ExtUtils::ParseXS::Constants::FH;
- $proto_re = $ExtUtils::ParseXS::Constants::proto_re;
- $Overload = $ExtUtils::ParseXS::Constants::Overload;
- $errors = $ExtUtils::ParseXS::Constants::errors;
- $Fallback = $ExtUtils::ParseXS::Constants::Fallback;
+ $self->{Overload} = $ExtUtils::ParseXS::Constants::Overload;
+ $self->{errors} = $ExtUtils::ParseXS::Constants::errors;
+ $self->{Fallback} = $ExtUtils::ParseXS::Constants::Fallback;
# Most of the 1500 lines below uses these globals. We'll have to
# clean this up sometime, probably. For now, we just pull them out
# of %args. -Ken
- $hiertype = $args{hiertype};
- $WantPrototypes = $args{prototypes};
- $WantVersionChk = $args{versioncheck};
- $WantLineNumbers = $args{linenumbers};
+ $self->{hiertype} = $args{hiertype};
+ $self->{WantPrototypes} = $args{prototypes};
+ $self->{WantVersionChk} = $args{versioncheck};
+ $self->{WantLineNumbers} = $args{linenumbers};
for my $f ($args{filename}) {
die "Missing required parameter 'filename'" unless $f;
- $filepathname = $f;
- ($dir, $filename) = (dirname($f), basename($f));
- $filepathname =~ s/\\/\\\\/g;
+ $self->{filepathname} = $f;
+ ($self->{dir}, $self->{filename}) = (dirname($f), basename($f));
+ $self->{filepathname} =~ s/\\/\\\\/g;
$IncludedFiles{$f}++;
}
my $orig_cwd = cwd();
my $orig_fh = select();
- chdir($dir);
+ chdir($self->{dir});
my $pwd = cwd();
my $csuffix = $args{csuffix};
- if ($WantLineNumbers) {
+ if ($self->{WantLineNumbers}) {
my $cfile;
if ( $args{outfile} ) {
$cfile = $args{outfile};
my $END = "!End!\n\n"; # "impossible" keyword (multiple newline)
# Match an XS keyword
- $BLOCK_re = '\s*(' .
+ $self->{BLOCK_re} = '\s*(' .
join('|' => @ExtUtils::ParseXS::Constants::keywords) .
"|$END)\\s*:";
print <<EOM;
/*
* This file was generated automatically by ExtUtils::ParseXS version $VERSION from the
- * contents of $filename. Do not edit this file, edit $filename instead.
+ * contents of $self->{filename}. Do not edit this file, edit $self->{filename} instead.
*
* ANY CHANGES MADE HERE WILL BE LOST!
*
EOM
- print("#line 1 \"$filepathname\"\n")
- if $WantLineNumbers;
+ print("#line 1 \"$self->{filepathname}\"\n")
+ if $self->{WantLineNumbers};
- # Open the input file (using basename'd $args{filename} due to chdir above)
- open($FH, $filename) or die "cannot open $filename: $!\n";
+ # Open the input file (using $self->{filename} which
+ # is a basename'd $args{filename} due to chdir above)
+ open($FH, $self->{filename}) or die "cannot open $self->{filename}: $!\n";
firstmodule:
while (<$FH>) {
# concatenated until 2 steps later, so we are safe.
# - Nicholas Clark
print("#if 0\n \"Skipped embedded POD.\"\n#endif\n");
- printf("#line %d \"$filepathname\"\n", $. + 1)
- if $WantLineNumbers;
+ printf("#line %d \"$self->{filepathname}\"\n", $. + 1)
+ if $self->{WantLineNumbers};
next firstmodule
}
# At this point $. is at end of file so die won't state the start
# of the problem, and as we haven't yet read any lines &death won't
# show the correct line in the message either.
- die ("Error: Unterminated pod in $filename, line $podstartline\n")
- unless $lastline;
+ die ("Error: Unterminated pod in $self->{filename}, line $podstartline\n")
+ unless $self->{lastline};
}
last if ($Package, $Prefix) =
/^MODULE\s*=\s*[\w:]+(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/;
exit 0; # Not a fatal error for the caller process
}
- print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $WantLineNumbers;
+ print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $self->{WantLineNumbers};
print <<"EOF";
#ifndef PERL_UNUSED_VAR
EOF
- print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $WantLineNumbers;
+ print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $self->{WantLineNumbers};
- $lastline = $_;
- $lastline_no = $.;
+ $self->{lastline} = $_;
+ $self->{lastline_no} = $.;
my (@BootCode, @outlist, $prepush_done, $xsreturn, $func_header, $orig_args, );
PARAGRAPH:
undef($prepush_done);
$interface_macro = 'XSINTERFACE_FUNC';
$interface_macro_set = 'XSINTERFACE_FUNC_SET';
- $ProtoThisXSUB = $WantPrototypes;
+ $ProtoThisXSUB = $self->{WantPrototypes};
$ScopeThisXSUB = 0;
$xsreturn = 0;
if (check_keyword("BOOT")) {
&check_cpp;
- push (@BootCode, "#line $line_no[@line_no - @line] \"$filepathname\"")
- if $WantLineNumbers && $line[0] !~ /^\s*#\s*line\b/;
+ push (@BootCode, "#line $line_no[@line_no - @line] \"$self->{filepathname}\"")
+ if $self->{WantLineNumbers} && $line[0] !~ /^\s*#\s*line\b/;
push (@BootCode, @line, "");
next PARAGRAPH;
}
}
else {
if ($ret_type ne "void") {
- print "\t" . &map_type($ret_type, 'RETVAL', $hiertype) . ";\n"
+ print "\t" . &map_type($ret_type, 'RETVAL', $self->{hiertype}) . ";\n"
if !$retvaldone;
$args_match{"RETVAL"} = 0;
$var_types{"RETVAL"} = $ret_type;
next;
}
last if $_ eq "$END:";
- death(/^$BLOCK_re/o ? "Misplaced `$1:'" : "Junk at end of function ($_)");
+ death(/^$self->{BLOCK_re}/o ? "Misplaced `$1:'" : "Junk at end of function ($_)");
}
print Q(<<"EOF") if $args{except};
}
} # END 'PARAGRAPH' 'while' loop
- if ($Overload) { # make it findable with fetchmethod
+ if ($self->{Overload}) { # make it findable with fetchmethod
print Q(<<"EOF");
#XS(XS_${Packid}_nil); /* prototype to pass -Wmissing-prototypes */
#XS(XS_${Packid}_nil)
# PERL_UNUSED_VAR(items); /* -W */
EOF
- print Q(<<"EOF") if $WantVersionChk;
+ print Q(<<"EOF") if $self->{WantVersionChk};
# XS_VERSION_BOOTCHECK;
#
EOF
#
EOF
- print Q(<<"EOF") if ($Overload);
+ print Q(<<"EOF") if ($self->{Overload});
# /* register the overloading (type 'A') magic */
# PL_amagic_generation++;
# /* The magic for overload gets a GV* via gv_fetchmeth as */
# /* the "fallback" status. */
# sv_setsv(
# get_sv( "${Package}::()", TRUE ),
-# $Fallback
+# $self->{Fallback}
# );
EOF
#
EOF
- warn("Please specify prototyping behavior for $filename (see perlxs manual)\n")
+ warn("Please specify prototyping behavior for $self->{filename} (see perlxs manual)\n")
unless $self->{ProtoUsed};
chdir($orig_cwd);
return 1;
}
-#sub errors { $errors }
-sub report_error_count { $errors }
+sub report_error_count { $self->{errors} }
# Input: ($_, @line) == unparsed input.
# Output: ($_, @line) == (rest of line, following lines).
# the "do" is required for right semantics
do { $_ = shift(@line) } while !/\S/ && @line;
- print("#line ", $line_no[@line_no - @line -1], " \"$filepathname\"\n")
- if $WantLineNumbers && !/^\s*#\s*line\b/ && !/^#if XSubPPtmp/;
- for (; defined($_) && !/^$BLOCK_re/o; $_ = shift(@line)) {
+ print("#line ", $line_no[@line_no - @line -1], " \"$self->{filepathname}\"\n")
+ if $self->{WantLineNumbers} && !/^\s*#\s*line\b/ && !/^#if XSubPPtmp/;
+ for (; defined($_) && !/^$self->{BLOCK_re}/o; $_ = shift(@line)) {
print "$_\n";
}
- print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $WantLineNumbers;
+ print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $self->{WantLineNumbers};
}
sub merge_section {
$_ = shift(@line);
}
- for (; defined($_) && !/^$BLOCK_re/o; $_ = shift(@line)) {
+ for (; defined($_) && !/^$self->{BLOCK_re}/o; $_ = shift(@line)) {
$in .= "$_\n";
}
chomp $in;
}
sub INPUT_handler {
- for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
+ for (; !/^$self->{BLOCK_re}/o; $_ = shift(@line)) {
last if /^\s*NOT_IMPLEMENTED_YET/;
next unless /\S/; # skip blank lines
# one can use 2-args map_type() unconditionally.
if ($var_type =~ / \( \s* \* \s* \) /x) {
# Function pointers are not yet supported with &output_init!
- print "\t" . &map_type($var_type, $var_name, $hiertype);
+ print "\t" . &map_type($var_type, $var_name, $self->{hiertype});
$printed_name = 1;
}
else {
- print "\t" . &map_type($var_type, undef, $hiertype);
+ print "\t" . &map_type($var_type, undef, $self->{hiertype});
$printed_name = 0;
}
$var_num = $args_match{$var_name};
}
sub OUTPUT_handler {
- for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
+ for (; !/^$self->{BLOCK_re}/o; $_ = shift(@line)) {
next unless /\S/;
if (/^\s*SETMAGIC\s*:\s*(ENABLE|DISABLE)\s*/) {
$DoSetMagic = ($1 eq "ENABLE" ? 1 : 0);
}
sub ATTRS_handler () {
- for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
+ for (; !/^$self->{BLOCK_re}/o; $_ = shift(@line)) {
next unless /\S/;
trim_whitespace($_);
push @Attributes, $_;
}
sub ALIAS_handler () {
- for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
+ for (; !/^$self->{BLOCK_re}/o; $_ = shift(@line)) {
next unless /\S/;
trim_whitespace($_);
GetAliases($_) if $_;
}
sub OVERLOAD_handler() {
- for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
+ for (; !/^$self->{BLOCK_re}/o; $_ = shift(@line)) {
next unless /\S/;
trim_whitespace($_);
while ( s/^\s*([\w:"\\)\+\-\*\/\%\<\>\.\&\|\^\!\~\{\}\=]+)\s*//) {
- $Overload = 1 unless $Overload;
+ $self->{Overload} = 1 unless $self->{Overload};
my $overload = "$Package\::(".$1;
push(@InitFileCode,
" (void)${newXS}(\"$overload\", XS_$Full_func_name, file$proto);\n");
# check for valid FALLBACK value
death ("Error: FALLBACK: TRUE/FALSE/UNDEF") unless exists $map{uc $_};
- $Fallback = $map{uc $_};
+ $self->{Fallback} = $map{uc $_};
}
death ("Error: VERSIONCHECK: ENABLE/DISABLE")
unless /^(ENABLE|DISABLE)/i;
- $WantVersionChk = 1 if $1 eq 'ENABLE';
- $WantVersionChk = 0 if $1 eq 'DISABLE';
+ $self->{WantVersionChk} = 1 if $1 eq 'ENABLE';
+ $self->{WantVersionChk} = 0 if $1 eq 'DISABLE';
}
death("Error: Only 1 PROTOTYPE definition allowed per xsub")
if $proto_in_this_xsub++;
- for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
+ for (; !/^$self->{BLOCK_re}/o; $_ = shift(@line)) {
next unless /\S/;
$specified = 1;
trim_whitespace($_);
death ("Error: PROTOTYPES: ENABLE/DISABLE")
unless /^(ENABLE|DISABLE)/i;
- $WantPrototypes = 1 if $1 eq 'ENABLE';
- $WantPrototypes = 0 if $1 eq 'DISABLE';
+ $self->{WantPrototypes} = 1 if $1 eq 'ENABLE';
+ $self->{WantPrototypes} = 0 if $1 eq 'DISABLE';
$self->{ProtoUsed} = 1;
}
# Save the current file context.
push(@XSStack, {
type => 'file',
- LastLine => $lastline,
- LastLineNo => $lastline_no,
+ LastLine => $self->{lastline},
+ LastLineNo => $self->{lastline_no},
Line => \@line,
LineNo => \@line_no,
- Filename => $filename,
- Filepathname => $filepathname,
+ Filename => $self->{filename},
+ Filepathname => $self->{filepathname},
Handle => $FH,
- IsPipe => scalar($filename =~ /\|\s*$/),
+ IsPipe => scalar($self->{filename} =~ /\|\s*$/),
%args,
});
print Q(<<"EOF");
#
-#/* INCLUDE: Including '$_' from '$filename' */
+#/* INCLUDE: Including '$_' from '$self->{filename}' */
#
EOF
- $filename = $_;
- $filepathname = File::Spec->catfile($dir, $filename);
+ $self->{filename} = $_;
+ $self->{filepathname} = File::Spec->catfile($self->{dir}, $self->{filename});
# Prime the pump by reading the first
# non-blank line
last unless /^\s*$/;
}
- $lastline = $_;
- $lastline_no = $.;
+ $self->{lastline} = $_;
+ $self->{lastline_no} = $.;
}
sub QuoteArgs {
print Q(<<"EOF");
#
-#/* INCLUDE_COMMAND: Including output of '$_' from '$filename' */
+#/* INCLUDE_COMMAND: Including output of '$_' from '$self->{filename}' */
#
EOF
- $filename = $_;
- $filepathname = $filename;
- $filepathname =~ s/\"/\\"/g;
+ $self->{filename} = $_;
+ $self->{filepathname} = $self->{filename};
+ $self->{filepathname} =~ s/\"/\\"/g;
# Prime the pump by reading the first
# non-blank line
last unless /^\s*$/;
}
- $lastline = $_;
- $lastline_no = $.;
+ $self->{lastline} = $_;
+ $self->{lastline_no} = $.;
}
sub PopFile() {
return 0 unless $XSStack[-1]{type} eq 'file';
my $data = pop @XSStack;
- my $ThisFile = $filename;
+ my $ThisFile = $self->{filename};
my $isPipe = $data->{IsPipe};
- --$IncludedFiles{$filename}
+ --$IncludedFiles{$self->{filename}}
unless $isPipe;
close $FH;
# $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};
+ $self->{filename} = $data->{Filename};
+ $self->{filepathname} = $data->{Filepathname};
+ $self->{lastline} = $data->{LastLine};
+ $self->{lastline_no} = $data->{LastLineNo};
@line = @{ $data->{Line} };
@line_no = @{ $data->{LineNo} };
if ($isPipe and $? ) {
- --$lastline_no;
- print STDERR "Error reading from pipe '$ThisFile': $! in $filename, line $lastline_no\n" ;
+ --$self->{lastline_no};
+ print STDERR "Error reading from pipe '$ThisFile': $! in $self->{filename}, line $self->{lastline_no}\n" ;
exit 1;
}
print Q(<<"EOF");
#
-#/* INCLUDE: Returning to '$filename' from '$ThisFile' */
+#/* INCLUDE: Returning to '$self->{filename}' from '$ThisFile' */
#
EOF
sub fetch_para {
# parse paragraph
death ("Error: Unterminated `#if/#ifdef/#ifndef'")
- if !defined $lastline && $XSStack[-1]{type} eq 'if';
+ if !defined $self->{lastline} && $XSStack[-1]{type} eq 'if';
@line = ();
@line_no = ();
- return PopFile() if !defined $lastline;
+ return PopFile() if !defined $self->{lastline};
- if ($lastline =~
+ if ($self->{lastline} =~
/^MODULE\s*=\s*([\w:]+)(?:\s+PACKAGE\s*=\s*([\w:]+))?(?:\s+PREFIX\s*=\s*(\S+))?\s*$/) {
my $Module = $1;
$Package = defined($2) ? $2 : ''; # keep -w happy
($Packid = $Package) =~ tr/:/_/;
$Packprefix = $Package;
$Packprefix .= "::" if $Packprefix ne "";
- $lastline = "";
+ $self->{lastline} = "";
}
for (;;) {
# Skip embedded PODs
- while ($lastline =~ /^=/) {
- while ($lastline = <$FH>) {
- last if ($lastline =~ /^=cut\s*$/);
+ while ($self->{lastline} =~ /^=/) {
+ while ($self->{lastline} = <$FH>) {
+ last if ($self->{lastline} =~ /^=cut\s*$/);
}
- death ("Error: Unterminated pod") unless $lastline;
- $lastline = <$FH>;
- chomp $lastline;
- $lastline =~ s/^\s+$//;
+ death ("Error: Unterminated pod") unless $self->{lastline};
+ $self->{lastline} = <$FH>;
+ chomp $self->{lastline};
+ $self->{lastline} =~ s/^\s+$//;
}
- if ($lastline !~ /^\s*#/ ||
+ if ($self->{lastline} !~ /^\s*#/ ||
# CPP directives:
# ANSI: if ifdef ifndef elif else endif define undef
# line error pragma
# gcc: warning include_next
# obj-c: import
# others: ident (gcc notes that some cpps have this one)
- $lastline =~ /^#[ \t]*(?:(?:if|ifn?def|elif|else|endif|define|undef|pragma|error|warning|line\s+\d+|ident)\b|(?:include(?:_next)?|import)\s*["<].*[>"])/) {
- last if $lastline =~ /^\S/ && @line && $line[-1] eq "";
- push(@line, $lastline);
- push(@line_no, $lastline_no);
+ $self->{lastline} =~ /^#[ \t]*(?:(?:if|ifn?def|elif|else|endif|define|undef|pragma|error|warning|line\s+\d+|ident)\b|(?:include(?:_next)?|import)\s*["<].*[>"])/) {
+ last if $self->{lastline} =~ /^\S/ && @line && $line[-1] eq "";
+ push(@line, $self->{lastline});
+ push(@line_no, $self->{lastline_no});
}
# Read next line and continuation lines
- last unless defined($lastline = <$FH>);
- $lastline_no = $.;
+ last unless defined($self->{lastline} = <$FH>);
+ $self->{lastline_no} = $.;
my $tmp_line;
- $lastline .= $tmp_line
- while ($lastline =~ /\\$/ && defined($tmp_line = <$FH>));
+ $self->{lastline} .= $tmp_line
+ while ($self->{lastline} =~ /\\$/ && defined($tmp_line = <$FH>));
- chomp $lastline;
- $lastline =~ s/^\s+$//;
+ chomp $self->{lastline};
+ $self->{lastline} =~ s/^\s+$//;
}
pop(@line), pop(@line_no) while @line && $line[-1] eq "";
1;
if defined $defaults{$var};
return;
}
- $type =~ tr/:/_/ unless $hiertype;
+ $type =~ tr/:/_/ unless $self->{hiertype};
blurt("Error: No INPUT definition for type '$type', typekind '$type_kind{$type}' found"), return
unless defined $input_expr{$tk};
my $expr = $input_expr{$tk};
# work out the line number
my $warn_line_number = $line_no[@line_no - @line -1];
- print STDERR "@_ in $filename, line $warn_line_number\n";
+ print STDERR "@_ in $self->{filename}, line $warn_line_number\n";
}
sub blurt {
Warn @_;
- $errors++
+ $self->{errors}++
}
sub death {
projects / platform / upstream / perl.git / commitdiff