From: James E. Keenan Date: Fri, 12 Mar 2010 02:54:57 +0000 (-0500) Subject: Continue tidying up the code, range lines 1000-end X-Git-Tag: accepted/trunk/20130322.191538~3330^2~164 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=505ef4a59d56acfa344039ccdc6982c7ef5507c1;p=platform%2Fupstream%2Fperl.git Continue tidying up the code, range lines 1000-end Uncuddle all '} elsif' and '} else' statements. Switch to 'use Exporter' rather than 'require' (for consistency). --- diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm index 9b042da..12f8a09 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm @@ -3,12 +3,11 @@ package ExtUtils::ParseXS; use 5.006; # We use /??{}/ in regexes use Cwd; use Config; +use Exporter; use File::Basename; use File::Spec; use Symbol; -require Exporter; - our (@ISA, @EXPORT_OK, $VERSION); @ISA = qw(Exporter); @EXPORT_OK = qw(process_file); @@ -541,7 +540,8 @@ EOF if (length $pre or $islength) { # Has a type if ($islength) { push @fake_INPUT_pre, $arg; - } else { + } + else { push @fake_INPUT, $arg; } # warn "pushing '$arg'\n"; @@ -1054,8 +1054,7 @@ EOF # } EOF - if (@BootCode) - { + if (@BootCode) { print "\n /* Initialisation Section */\n\n"; @line = @BootCode; print_section(); @@ -1106,70 +1105,67 @@ sub standard_typemap_locations { return @tm; } -sub TrimWhitespace -{ +sub TrimWhitespace { $_[0] =~ s/^\s+|\s+$//go; } -sub TidyType - { - local ($_) = @_; +sub TidyType { + local ($_) = @_; - # rationalise any '*' by joining them into bunches and removing whitespace - s#\s*(\*+)\s*#$1#g; - s#(\*+)# $1 #g; + # rationalise any '*' by joining them into bunches and removing whitespace + s#\s*(\*+)\s*#$1#g; + s#(\*+)# $1 #g; - # change multiple whitespace into a single space - s/\s+/ /g; + # change multiple whitespace into a single space + s/\s+/ /g; - # trim leading & trailing whitespace - TrimWhitespace($_); + # trim leading & trailing whitespace + TrimWhitespace($_); - $_; + $_; } # Input: ($_, @line) == unparsed input. # Output: ($_, @line) == (rest of line, following lines). # Return: the matched keyword if found, otherwise 0 sub check_keyword { - $_ = shift(@line) while !/\S/ && @line; - s/^(\s*)($_[0])\s*:\s*(?:#.*)?/$1/s && $2; + $_ = shift(@line) while !/\S/ && @line; + s/^(\s*)($_[0])\s*:\s*(?:#.*)?/$1/s && $2; } sub print_section { - # the "do" is required for right semantics - do { $_ = shift(@line) } while !/\S/ && @line; + # the "do" is required for right semantics + do { $_ = shift(@line) } while !/\S/ && @line; - print("#line ", $line_no[@line_no - @line -1], " \"$filepathname\"\n") + 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)) { + for (; defined($_) && !/^$BLOCK_re/o; $_ = shift(@line)) { print "$_\n"; - } - print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $WantLineNumbers; + } + print 'ExtUtils::ParseXS::CountLines'->end_marker, "\n" if $WantLineNumbers; } sub merge_section { - my $in = ''; + my $in = ''; - while (!/\S/ && @line) { - $_ = shift(@line); - } + while (!/\S/ && @line) { + $_ = shift(@line); + } - for (; defined($_) && !/^$BLOCK_re/o; $_ = shift(@line)) { - $in .= "$_\n"; - } - chomp $in; - return $in; + for (; defined($_) && !/^$BLOCK_re/o; $_ = shift(@line)) { + $in .= "$_\n"; } + chomp $in; + return $in; +} -sub process_keyword($) - { - my($pattern) = @_; - my $kwd; +sub process_keyword($) { + my($pattern) = @_; + my $kwd; - &{"${kwd}_handler"}() - while $kwd = check_keyword($pattern); - } + &{"${kwd}_handler"}() + while $kwd = check_keyword($pattern); +} sub CASE_handler { blurt ("Error: `CASE:' after unconditional `CASE:'") @@ -1223,7 +1219,8 @@ sub INPUT_handler { # Function pointers are not yet supported with &output_init! print "\t" . &map_type($var_type, $var_name); $name_printed = 1; - } else { + } + else { print "\t" . &map_type($var_type); $name_printed = 0; } @@ -1233,19 +1230,23 @@ sub INPUT_handler { if $var_num; $func_args =~ s/\b($var_name)\b/&$1/ if $var_addr; if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/ - or $in_out{$var_name} and $in_out{$var_name} =~ /^OUT/ - and $var_init !~ /\S/) { + or $in_out{$var_name} and $in_out{$var_name} =~ /^OUT/ + and $var_init !~ /\S/) { if ($name_printed) { - print ";\n"; - } else { - print "\t$var_name;\n"; + print ";\n"; } - } elsif ($var_init =~ /\S/) { + else { + print "\t$var_name;\n"; + } + } + elsif ($var_init =~ /\S/) { &output_init($var_type, $var_num, $var_name, $var_init, $name_printed); - } elsif ($var_num) { + } + elsif ($var_num) { # generate initialization code &generate_init($var_type, $var_num, $var_name, $name_printed); - } else { + } + else { print ";\n"; } } @@ -1275,7 +1276,8 @@ sub OUTPUT_handler { if ($outcode) { print "\t$outcode\n"; print "\tSvSETMAGIC(ST(" , $var_num-1 , "));\n" if $DoSetMagic; - } else { + } + else { &generate_output($var_types{$outarg}, $var_num, $outarg, $DoSetMagic); } delete $in_out{$outarg} # No need to auto-OUTPUT @@ -1296,7 +1298,8 @@ sub INTERFACE_MACRO_handler() { TrimWhitespace($in); if ($in =~ /\s/) { # two ($interface_macro, $interface_macro_set) = split ' ', $in; - } else { + } + else { $interface_macro = $in; $interface_macro_set = 'UNKNOWN_CVT'; # catch later } @@ -1326,61 +1329,57 @@ sub PREINIT_handler() { print_section() } sub POSTCALL_handler() { print_section() } sub INIT_handler() { print_section() } -sub GetAliases - { - my ($line) = @_; - my ($orig) = $line; - my ($alias); - my ($value); - - # Parse alias definitions - # format is - # alias = value alias = value ... +sub GetAliases { + my ($line) = @_; + my ($orig) = $line; + my ($alias); + my ($value); - while ($line =~ s/^\s*([\w:]+)\s*=\s*(\w+)\s*//) { - $alias = $1; - $orig_alias = $alias; - $value = $2; + # Parse alias definitions + # format is + # alias = value alias = value ... - # check for optional package definition in the alias - $alias = $Packprefix . $alias if $alias !~ /::/; + while ($line =~ s/^\s*([\w:]+)\s*=\s*(\w+)\s*//) { + $alias = $1; + $orig_alias = $alias; + $value = $2; - # check for duplicate alias name & duplicate value - Warn("Warning: Ignoring duplicate alias '$orig_alias'") - if defined $XsubAliases{$alias}; + # check for optional package definition in the alias + $alias = $Packprefix . $alias if $alias !~ /::/; - Warn("Warning: Aliases '$orig_alias' and '$XsubAliasValues{$value}' have identical values") - if $XsubAliasValues{$value}; + # check for duplicate alias name & duplicate value + Warn("Warning: Ignoring duplicate alias '$orig_alias'") + if defined $XsubAliases{$alias}; - $XsubAliases = 1; - $XsubAliases{$alias} = $value; - $XsubAliasValues{$value} = $orig_alias; - } + Warn("Warning: Aliases '$orig_alias' and '$XsubAliasValues{$value}' have identical values") + if $XsubAliasValues{$value}; - blurt("Error: Cannot parse ALIAS definitions from '$orig'") - if $line; + $XsubAliases = 1; + $XsubAliases{$alias} = $value; + $XsubAliasValues{$value} = $orig_alias; } -sub ATTRS_handler () - { - for (; !/^$BLOCK_re/o; $_ = shift(@line)) { - next unless /\S/; - TrimWhitespace($_); - push @Attributes, $_; - } + blurt("Error: Cannot parse ALIAS definitions from '$orig'") + if $line; +} + +sub ATTRS_handler () { + for (; !/^$BLOCK_re/o; $_ = shift(@line)) { + next unless /\S/; + TrimWhitespace($_); + push @Attributes, $_; } +} -sub ALIAS_handler () - { - for (; !/^$BLOCK_re/o; $_ = shift(@line)) { - next unless /\S/; - TrimWhitespace($_); - GetAliases($_) if $_; - } +sub ALIAS_handler () { + for (; !/^$BLOCK_re/o; $_ = shift(@line)) { + next unless /\S/; + TrimWhitespace($_); + GetAliases($_) if $_; } +} -sub OVERLOAD_handler() -{ +sub OVERLOAD_handler() { for (; !/^$BLOCK_re/o; $_ = shift(@line)) { next unless /\S/; TrimWhitespace($_); @@ -1393,17 +1392,16 @@ sub OVERLOAD_handler() } } -sub FALLBACK_handler() -{ +sub FALLBACK_handler() { # the rest of the current line should contain either TRUE, # FALSE or UNDEF TrimWhitespace($_); my %map = ( - TRUE => "&PL_sv_yes", 1 => "&PL_sv_yes", - FALSE => "&PL_sv_no", 0 => "&PL_sv_no", - UNDEF => "&PL_sv_undef", - ); + TRUE => "&PL_sv_yes", 1 => "&PL_sv_yes", + FALSE => "&PL_sv_no", 0 => "&PL_sv_no", + UNDEF => "&PL_sv_undef", + ); # check for valid FALLBACK value death ("Error: FALLBACK: TRUE/FALSE/UNDEF") unless exists $map{uc $_}; @@ -1412,295 +1410,282 @@ sub FALLBACK_handler() } -sub REQUIRE_handler () - { - # the rest of the current line should contain a version number - my ($Ver) = $_; - - TrimWhitespace($Ver); +sub REQUIRE_handler () { + # the rest of the current line should contain a version number + my ($Ver) = $_; - death ("Error: REQUIRE expects a version number") - unless $Ver; + TrimWhitespace($Ver); - # check that the version number is of the form n.n - death ("Error: REQUIRE: expected a number, got '$Ver'") - unless $Ver =~ /^\d+(\.\d*)?/; + death ("Error: REQUIRE expects a version number") + unless $Ver; - death ("Error: xsubpp $Ver (or better) required--this is only $VERSION.") - unless $VERSION >= $Ver; - } + # check that the version number is of the form n.n + death ("Error: REQUIRE: expected a number, got '$Ver'") + unless $Ver =~ /^\d+(\.\d*)?/; -sub VERSIONCHECK_handler () - { - # the rest of the current line should contain either ENABLE or - # DISABLE + death ("Error: xsubpp $Ver (or better) required--this is only $VERSION.") + unless $VERSION >= $Ver; +} - TrimWhitespace($_); +sub VERSIONCHECK_handler () { + # the rest of the current line should contain either ENABLE or + # DISABLE - # check for ENABLE/DISABLE - death ("Error: VERSIONCHECK: ENABLE/DISABLE") - unless /^(ENABLE|DISABLE)/i; + TrimWhitespace($_); - $WantVersionChk = 1 if $1 eq 'ENABLE'; - $WantVersionChk = 0 if $1 eq 'DISABLE'; + # check for ENABLE/DISABLE + death ("Error: VERSIONCHECK: ENABLE/DISABLE") + unless /^(ENABLE|DISABLE)/i; - } + $WantVersionChk = 1 if $1 eq 'ENABLE'; + $WantVersionChk = 0 if $1 eq 'DISABLE'; -sub PROTOTYPE_handler () - { - my $specified; - - death("Error: Only 1 PROTOTYPE definition allowed per xsub") - if $proto_in_this_xsub ++; - - for (; !/^$BLOCK_re/o; $_ = shift(@line)) { - next unless /\S/; - $specified = 1; - TrimWhitespace($_); - if ($_ eq 'DISABLE') { - $ProtoThisXSUB = 0 - } elsif ($_ eq 'ENABLE') { - $ProtoThisXSUB = 1 - } else { - # remove any whitespace - s/\s+//g; - death("Error: Invalid prototype '$_'") - unless ValidProtoString($_); - $ProtoThisXSUB = C_string($_); - } - } +} - # If no prototype specified, then assume empty prototype "" - $ProtoThisXSUB = 2 unless $specified; +sub PROTOTYPE_handler () { + my $specified; - $ProtoUsed = 1; + death("Error: Only 1 PROTOTYPE definition allowed per xsub") + if $proto_in_this_xsub ++; + for (; !/^$BLOCK_re/o; $_ = shift(@line)) { + next unless /\S/; + $specified = 1; + TrimWhitespace($_); + if ($_ eq 'DISABLE') { + $ProtoThisXSUB = 0; + } + elsif ($_ eq 'ENABLE') { + $ProtoThisXSUB = 1; + } + else { + # remove any whitespace + s/\s+//g; + death("Error: Invalid prototype '$_'") + unless ValidProtoString($_); + $ProtoThisXSUB = C_string($_); + } } -sub SCOPE_handler () - { - death("Error: Only 1 SCOPE declaration allowed per xsub") - if $scope_in_this_xsub ++; + # If no prototype specified, then assume empty prototype "" + $ProtoThisXSUB = 2 unless $specified; - TrimWhitespace($_); - death ("Error: SCOPE: ENABLE/DISABLE") - unless /^(ENABLE|DISABLE)\b/i; - $ScopeThisXSUB = ( uc($1) eq 'ENABLE' ); - } + $ProtoUsed = 1; +} -sub PROTOTYPES_handler () - { - # the rest of the current line should contain either ENABLE or - # DISABLE +sub SCOPE_handler () { + death("Error: Only 1 SCOPE declaration allowed per xsub") + if $scope_in_this_xsub ++; - TrimWhitespace($_); + TrimWhitespace($_); + death ("Error: SCOPE: ENABLE/DISABLE") + unless /^(ENABLE|DISABLE)\b/i; + $ScopeThisXSUB = ( uc($1) eq 'ENABLE' ); +} - # check for ENABLE/DISABLE - death ("Error: PROTOTYPES: ENABLE/DISABLE") - unless /^(ENABLE|DISABLE)/i; +sub PROTOTYPES_handler () { + # the rest of the current line should contain either ENABLE or + # DISABLE - $WantPrototypes = 1 if $1 eq 'ENABLE'; - $WantPrototypes = 0 if $1 eq 'DISABLE'; - $ProtoUsed = 1; + TrimWhitespace($_); - } + # check for ENABLE/DISABLE + death ("Error: PROTOTYPES: ENABLE/DISABLE") + unless /^(ENABLE|DISABLE)/i; -sub PushXSStack - { - my %args = @_; - # Save the current file context. - push(@XSStack, { - type => 'file', - LastLine => $lastline, - LastLineNo => $lastline_no, - Line => \@line, - LineNo => \@line_no, - Filename => $filename, - Filepathname => $filepathname, - Handle => $FH, - IsPipe => scalar($filename =~ /\|\s*$/), - %args, - }); + $WantPrototypes = 1 if $1 eq 'ENABLE'; + $WantPrototypes = 0 if $1 eq 'DISABLE'; + $ProtoUsed = 1; +} - } +sub PushXSStack { + # Save the current file context. + push(@XSStack, { + type => 'file', + LastLine => $lastline, + LastLineNo => $lastline_no, + Line => \@line, + LineNo => \@line_no, + Filename => $filename, + Filepathname => $filepathname, + Handle => $FH, + IsPipe => scalar($filename =~ /\|\s*$/), + %args, + }); -sub INCLUDE_handler () - { - # the rest of the current line should contain a valid filename +} - TrimWhitespace($_); +sub INCLUDE_handler () { + # the rest of the current line should contain a valid filename - death("INCLUDE: filename missing") - unless $_; + TrimWhitespace($_); - death("INCLUDE: output pipe is illegal") - if /^\s*\|/; + death("INCLUDE: filename missing") + unless $_; - # simple minded recursion detector - death("INCLUDE loop detected") - if $IncludedFiles{$_}; + death("INCLUDE: output pipe is illegal") + if /^\s*\|/; - ++ $IncludedFiles{$_} unless /\|\s*$/; + # simple minded recursion detector + death("INCLUDE loop detected") + if $IncludedFiles{$_}; - if (/\|\s*$/ && /^\s*perl\s/) { - Warn("The INCLUDE directive with a command is discouraged." . - " Use INCLUDE_COMMAND instead! In particular using 'perl'" . - " in an 'INCLUDE: ... |' directive is not guaranteed to pick" . - " up the correct perl. The INCLUDE_COMMAND directive allows" . - " the use of \$^X as the currently running perl, see" . - " 'perldoc perlxs' for details."); - } + ++ $IncludedFiles{$_} unless /\|\s*$/; + + if (/\|\s*$/ && /^\s*perl\s/) { + Warn("The INCLUDE directive with a command is discouraged." . + " Use INCLUDE_COMMAND instead! In particular using 'perl'" . + " in an 'INCLUDE: ... |' directive is not guaranteed to pick" . + " up the correct perl. The INCLUDE_COMMAND directive allows" . + " the use of \$^X as the currently running perl, see" . + " 'perldoc perlxs' for details."); + } - PushXSStack(); + PushXSStack(); - $FH = Symbol::gensym(); + $FH = Symbol::gensym(); - # open the new file - open ($FH, "$_") or death("Cannot open '$_': $!"); + # open the new file + open ($FH, "$_") or death("Cannot open '$_': $!"); - print Q(<<"EOF"); + print Q(<<"EOF"); # #/* INCLUDE: Including '$_' from '$filename' */ # EOF - $filename = $_; - $filepathname = File::Spec->catfile($dir, $filename); + $filename = $_; + $filepathname = File::Spec->catfile($dir, $filename); - # Prime the pump by reading the first - # non-blank line + # Prime the pump by reading the first + # non-blank line - # skip leading blank lines - while (<$FH>) { - last unless /^\s*$/; - } - - $lastline = $_; - $lastline_no = $.; + # skip leading blank lines + while (<$FH>) { + last unless /^\s*$/; } + $lastline = $_; + $lastline_no = $.; +} + sub QuoteArgs { - my $cmd = shift; - my @args = split /\s+/, $cmd; - $cmd = shift @args; - for (@args) { - $_ = q(").$_.q(") if !/^\"/ && length($_) > 0; - } - return join (' ', ($cmd, @args)); + my $cmd = shift; + my @args = split /\s+/, $cmd; + $cmd = shift @args; + for (@args) { + $_ = q(").$_.q(") if !/^\"/ && length($_) > 0; } + return join (' ', ($cmd, @args)); +} -sub INCLUDE_COMMAND_handler () - { - # the rest of the current line should contain a valid command +sub INCLUDE_COMMAND_handler () { + # the rest of the current line should contain a valid command - TrimWhitespace($_); + TrimWhitespace($_); - $_ = QuoteArgs($_) if $^O eq 'VMS'; + $_ = QuoteArgs($_) if $^O eq 'VMS'; - death("INCLUDE_COMMAND: command missing") - unless $_; + death("INCLUDE_COMMAND: command missing") + unless $_; - death("INCLUDE_COMMAND: pipes are illegal") - if /^\s*\|/ or /\|\s*$/; + death("INCLUDE_COMMAND: pipes are illegal") + if /^\s*\|/ or /\|\s*$/; - PushXSStack( IsPipe => 1 ); + PushXSStack( IsPipe => 1 ); - $FH = Symbol::gensym(); + $FH = Symbol::gensym(); - # If $^X is used in INCLUDE_COMMAND, we know it's supposed to be - # the same perl interpreter as we're currently running - s/^\s*\$\^X/$^X/; + # If $^X is used in INCLUDE_COMMAND, we know it's supposed to be + # the same perl interpreter as we're currently running + s/^\s*\$\^X/$^X/; - # open the new file - open ($FH, "-|", "$_") - or death("Cannot run command '$_' to include its output: $!"); + # open the new file + open ($FH, "-|", "$_") + or death("Cannot run command '$_' to include its output: $!"); - print Q(<<"EOF"); + print Q(<<"EOF"); # #/* INCLUDE_COMMAND: Including output of '$_' from '$filename' */ # EOF - $filename = $_; - $filepathname = $filename; - $filepathname =~ s/\"/\\"/g; + $filename = $_; + $filepathname = $filename; + $filepathname =~ s/\"/\\"/g; - # Prime the pump by reading the first - # non-blank line + # Prime the pump by reading the first + # non-blank line - # skip leading blank lines - while (<$FH>) { - last unless /^\s*$/; - } - - $lastline = $_; - $lastline_no = $.; + # skip leading blank lines + while (<$FH>) { + last unless /^\s*$/; } -sub PopFile() - { - return 0 unless $XSStack[-1]{type} eq 'file'; + $lastline = $_; + $lastline_no = $.; +} - my $data = pop @XSStack; - my $ThisFile = $filename; - my $isPipe = $data->{IsPipe}; +sub PopFile() { + return 0 unless $XSStack[-1]{type} eq 'file'; - -- $IncludedFiles{$filename} - unless $isPipe; + my $data = pop @XSStack; + my $ThisFile = $filename; + my $isPipe = $data->{IsPipe}; - close $FH; + -- $IncludedFiles{$filename} + unless $isPipe; - $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} }; - @line_no = @{ $data->{LineNo} }; + close $FH; - if ($isPipe and $? ) { - -- $lastline_no; - print STDERR "Error reading from pipe '$ThisFile': $! in $filename, line $lastline_no\n" ; - exit 1; - } + $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} }; + @line_no = @{ $data->{LineNo} }; + + if ($isPipe and $? ) { + -- $lastline_no; + print STDERR "Error reading from pipe '$ThisFile': $! in $filename, line $lastline_no\n" ; + exit 1; + } - print Q(<<"EOF"); + print Q(<<"EOF"); # #/* INCLUDE: Returning to '$filename' from '$ThisFile' */ # EOF - return 1; - } - -sub ValidProtoString ($) - { - my($string) = @_; + return 1; +} - if ( $string =~ /^$proto_re+$/ ) { - return $string; - } +sub ValidProtoString ($) { + my($string) = @_; - return 0; + if ( $string =~ /^$proto_re+$/ ) { + return $string; } -sub C_string ($) - { - my($string) = @_; + return 0; +} - $string =~ s[\\][\\\\]g; - $string; - } +sub C_string ($) { + my($string) = @_; -sub ProtoString ($) - { - my ($type) = @_; + $string =~ s[\\][\\\\]g; + $string; +} - $proto_letter{$type} or "\$"; - } +sub ProtoString ($) { + my ($type) = @_; + + $proto_letter{$type} or "\$"; +} sub check_cpp { my @cpp = grep(/^\#\s*(?:if|e\w+)/, @line); @@ -1708,14 +1693,16 @@ sub check_cpp { my ($cpp, $cpplevel); for $cpp (@cpp) { if ($cpp =~ /^\#\s*if/) { - $cpplevel++; - } elsif (!$cpplevel) { - Warn("Warning: #else/elif/endif without #if in this function"); - print STDERR " (precede it with a blank line if the matching #if is outside the function)\n" - if $XSStack[-1]{type} eq 'if'; - return; - } elsif ($cpp =~ /^\#\s*endif/) { - $cpplevel--; + $cpplevel++; + } + elsif (!$cpplevel) { + Warn("Warning: #else/elif/endif without #if in this function"); + print STDERR " (precede it with a blank line if the matching #if is outside the function)\n" + if $XSStack[-1]{type} eq 'if'; + return; + } + elsif ($cpp =~ /^\#\s*endif/) { + $cpplevel--; } } Warn("Warning: #if without #endif in this function") if $cpplevel; @@ -1757,7 +1744,7 @@ sub fetch_para { # Skip embedded PODs while ($lastline =~ /^=/) { while ($lastline = <$FH>) { - last if ($lastline =~ /^=cut\s*$/); + last if ($lastline =~ /^=cut\s*$/); } death ("Error: Unterminated pod") unless $lastline; $lastline = <$FH>; @@ -1798,45 +1785,46 @@ sub output_init { if ( $init =~ /^=/ ) { if ($name_printed) { eval qq/print " $init\\n"/; - } else { + } + else { eval qq/print "\\t$var $init\\n"/; } warn $@ if $@; - } else { + } + else { if ( $init =~ s/^\+// && $num ) { &generate_init($type, $num, $var, $name_printed); - } elsif ($name_printed) { + } + elsif ($name_printed) { print ";\n"; $init =~ s/^;//; - } else { + } + else { eval qq/print "\\t$var;\\n"/; warn $@ if $@; $init =~ s/^;//; } $deferred .= eval qq/"\\n\\t$init\\n"/; - warn $@ if $@; + warn $@ if $@; } } -sub Warn - { - # work out the line number - my $line_no = $line_no[@line_no - @line -1]; +sub Warn { + # work out the line number + my $line_no = $line_no[@line_no - @line -1]; - print STDERR "@_ in $filename, line $line_no\n"; - } + print STDERR "@_ in $filename, line $line_no\n"; +} -sub blurt - { - Warn @_; - $errors ++ - } +sub blurt { + Warn @_; + $errors ++ +} -sub death - { - Warn @_; - exit 1; - } +sub death { + Warn @_; + exit 1; +} sub generate_init { local($type, $num, $var) = @_; @@ -1886,26 +1874,31 @@ sub generate_init { $expr =~ s/ /\t/g; if ($name_printed) { print ";\n"; - } else { + } + else { eval qq/print "\\t$var;\\n"/; warn $@ if $@; } if ($defaults{$var} eq 'NO_INIT') { $deferred .= eval qq/"\\n\\tif (items >= $num) {\\n$expr;\\n\\t}\\n"/; - } else { + } + else { $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/; } warn $@ if $@; - } elsif ($ScopeThisXSUB or $expr !~ /^\s*\$var =/) { + } + elsif ($ScopeThisXSUB or $expr !~ /^\s*\$var =/) { if ($name_printed) { print ";\n"; - } else { + } + else { eval qq/print "\\t$var;\\n"/; warn $@ if $@; } $deferred .= eval qq/"\\n$expr;\\n"/; warn $@ if $@; - } else { + } + else { die "panic: do not know how to handle this branch for function pointers" if $name_printed; eval qq/print "$expr;\\n"/; @@ -1924,7 +1917,8 @@ sub generate_output { print "\t$arg = sv_newmortal();\n"; print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1));\n"; print "\tSvSETMAGIC($arg);\n" if $do_setmagic; - } else { + } + else { blurt("Error: '$type' not in typemap"), return unless defined($type_kind{$type}); blurt("Error: No OUTPUT definition for type '$type', typekind '$type_kind{$type}' found"), return @@ -1947,38 +1941,43 @@ sub generate_output { eval "print qq\a$expr\a"; warn $@ if $@; print "\t\tSvSETMAGIC(ST(ix_$var));\n" if $do_setmagic; - } elsif ($var eq 'RETVAL') { + } + elsif ($var eq 'RETVAL') { if ($expr =~ /^\t\$arg = new/) { - # We expect that $arg has refcnt 1, so we need to - # mortalize it. - eval "print qq\a$expr\a"; - warn $@ if $@; - print "\tsv_2mortal(ST($num));\n"; - print "\tSvSETMAGIC(ST($num));\n" if $do_setmagic; - } elsif ($expr =~ /^\s*\$arg\s*=/) { - # We expect that $arg has refcnt >=1, so we need - # to mortalize it! - eval "print qq\a$expr\a"; - warn $@ if $@; - print "\tsv_2mortal(ST(0));\n"; - print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic; - } else { - # Just hope that the entry would safely write it - # over an already mortalized value. By - # coincidence, something like $arg = &sv_undef - # works too. - print "\tST(0) = sv_newmortal();\n"; - eval "print qq\a$expr\a"; - warn $@ if $@; - # new mortals don't have set magic + # We expect that $arg has refcnt 1, so we need to + # mortalize it. + eval "print qq\a$expr\a"; + warn $@ if $@; + print "\tsv_2mortal(ST($num));\n"; + print "\tSvSETMAGIC(ST($num));\n" if $do_setmagic; + } + elsif ($expr =~ /^\s*\$arg\s*=/) { + # We expect that $arg has refcnt >=1, so we need + # to mortalize it! + eval "print qq\a$expr\a"; + warn $@ if $@; + print "\tsv_2mortal(ST(0));\n"; + print "\tSvSETMAGIC(ST(0));\n" if $do_setmagic; } - } elsif ($do_push) { + else { + # Just hope that the entry would safely write it + # over an already mortalized value. By + # coincidence, something like $arg = &sv_undef + # works too. + print "\tST(0) = sv_newmortal();\n"; + eval "print qq\a$expr\a"; + warn $@ if $@; + # new mortals don't have set magic + } + } + elsif ($do_push) { print "\tPUSHs(sv_newmortal());\n"; $arg = "ST($num)"; eval "print qq\a$expr\a"; warn $@ if $@; print "\tSvSETMAGIC($arg);\n" if $do_setmagic; - } elsif ($arg =~ /^ST\(\d+\)$/) { + } + elsif ($arg =~ /^ST\(\d+\)$/) { eval "print qq\a$expr\a"; warn $@ if $@; print "\tSvSETMAGIC($arg);\n" if $do_setmagic; @@ -1995,7 +1994,8 @@ sub map_type { if ($varname) { if ($varname && $type =~ / \( \s* \* (?= \s* \) ) /xg) { (substr $type, pos $type, 0) = " $varname "; - } else { + } + else { $type .= "\t$varname"; } } @@ -2014,10 +2014,11 @@ sub TIEHANDLE { $cfile =~ s/\\/\\\\/g; $SECTION_END_MARKER = qq{#line --- "$cfile"}; - return bless {buffer => '', - fh => $fh, - line_no => 1, - }, $class; + return bless { + buffer => '', + fh => $fh, + line_no => 1, + }, $class; } sub PRINT { @@ -2053,7 +2054,6 @@ sub end_marker { return $SECTION_END_MARKER; } - 1; __END__