From c2d2fdd09b649a6c5691b462909152208167f3e6 Mon Sep 17 00:00:00 2001 From: "James E. Keenan" Date: Sat, 27 Mar 2010 18:22:13 -0400 Subject: [PATCH] Move more globals into the global $self Move $proto_re, $Overload, $errors, $Fallback, $hiertype, $WantPrototypes, $WantVersionChk, $WantLineNumbers, $filepathname, $dir, $filename, $BLOCK_re, $lastline, $lastline_no into $self. $proto_re not used within ParseXS.pm, so remove it. $FH did not play well with $self inside angle-bracket operator (while loop). $Package could not be transformed either, probably due to problems in its usage as ${Package} inside HEREdocs. --- dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm | 222 +++++++++++++------------- 1 file changed, 110 insertions(+), 112 deletions(-) diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm index 57ed120..ebbf4b6 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm @@ -30,10 +30,9 @@ our $VERSION = '3'; $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, @@ -86,25 +85,24 @@ sub process_file { 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}++; } @@ -121,11 +119,11 @@ sub process_file { 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}; @@ -165,7 +163,7 @@ sub process_file { 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*:"; @@ -187,7 +185,7 @@ sub process_file { print <{filename}. Do not edit this file, edit $self->{filename} instead. * * ANY CHANGES MADE HERE WILL BE LOST! * @@ -196,11 +194,12 @@ sub process_file { 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>) { @@ -222,8 +221,8 @@ EOM # 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 } @@ -231,8 +230,8 @@ EOM # 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*$/; @@ -244,7 +243,7 @@ EOM 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 @@ -303,10 +302,10 @@ S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params) 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: @@ -382,7 +381,7 @@ EOF undef($prepush_done); $interface_macro = 'XSINTERFACE_FUNC'; $interface_macro_set = 'XSINTERFACE_FUNC_SET'; - $ProtoThisXSUB = $WantPrototypes; + $ProtoThisXSUB = $self->{WantPrototypes}; $ScopeThisXSUB = 0; $xsreturn = 0; @@ -397,8 +396,8 @@ EOF 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; } @@ -700,7 +699,7 @@ EOF } 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; @@ -866,7 +865,7 @@ EOF 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}; @@ -953,7 +952,7 @@ EOF } } # 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) @@ -1013,7 +1012,7 @@ EOF # PERL_UNUSED_VAR(items); /* -W */ EOF - print Q(<<"EOF") if $WantVersionChk; + print Q(<<"EOF") if $self->{WantVersionChk}; # XS_VERSION_BOOTCHECK; # EOF @@ -1024,7 +1023,7 @@ 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 */ @@ -1032,7 +1031,7 @@ EOF # /* the "fallback" status. */ # sv_setsv( # get_sv( "${Package}::()", TRUE ), -# $Fallback +# $self->{Fallback} # ); EOF @@ -1062,7 +1061,7 @@ 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); @@ -1073,8 +1072,7 @@ EOF 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). @@ -1088,12 +1086,12 @@ sub print_section { # 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 { @@ -1103,7 +1101,7 @@ sub merge_section { $_ = shift(@line); } - for (; defined($_) && !/^$BLOCK_re/o; $_ = shift(@line)) { + for (; defined($_) && !/^$self->{BLOCK_re}/o; $_ = shift(@line)) { $in .= "$_\n"; } chomp $in; @@ -1130,7 +1128,7 @@ sub CASE_handler { } 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 @@ -1169,11 +1167,11 @@ sub INPUT_handler { # 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}; @@ -1216,7 +1214,7 @@ sub INPUT_handler { } 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); @@ -1330,7 +1328,7 @@ sub GetAliases { } sub ATTRS_handler () { - for (; !/^$BLOCK_re/o; $_ = shift(@line)) { + for (; !/^$self->{BLOCK_re}/o; $_ = shift(@line)) { next unless /\S/; trim_whitespace($_); push @Attributes, $_; @@ -1338,7 +1336,7 @@ sub ATTRS_handler () { } sub ALIAS_handler () { - for (; !/^$BLOCK_re/o; $_ = shift(@line)) { + for (; !/^$self->{BLOCK_re}/o; $_ = shift(@line)) { next unless /\S/; trim_whitespace($_); GetAliases($_) if $_; @@ -1346,11 +1344,11 @@ sub ALIAS_handler () { } 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"); @@ -1372,7 +1370,7 @@ sub FALLBACK_handler() { # check for valid FALLBACK value death ("Error: FALLBACK: TRUE/FALSE/UNDEF") unless exists $map{uc $_}; - $Fallback = $map{uc $_}; + $self->{Fallback} = $map{uc $_}; } @@ -1403,8 +1401,8 @@ sub VERSIONCHECK_handler () { 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'; } @@ -1414,7 +1412,7 @@ sub PROTOTYPE_handler () { 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($_); @@ -1459,8 +1457,8 @@ sub PROTOTYPES_handler () { 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; } @@ -1470,14 +1468,14 @@ sub PushXSStack { # 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, }); @@ -1518,12 +1516,12 @@ sub INCLUDE_handler () { 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 @@ -1533,8 +1531,8 @@ EOF last unless /^\s*$/; } - $lastline = $_; - $lastline_no = $.; + $self->{lastline} = $_; + $self->{lastline_no} = $.; } sub QuoteArgs { @@ -1574,13 +1572,13 @@ sub INCLUDE_COMMAND_handler () { 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 @@ -1590,18 +1588,18 @@ EOF 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; @@ -1610,22 +1608,22 @@ sub PopFile() { # $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 @@ -1667,12 +1665,12 @@ sub Q { 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 @@ -1682,42 +1680,42 @@ sub fetch_para { ($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; @@ -1794,7 +1792,7 @@ sub generate_init { 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}; @@ -1942,12 +1940,12 @@ sub Warn { # 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 { -- 1.8.3.1