($XSS_work_idx, $cpp_next_tmp) = (0, "XSubPPtmpAAAA");
@InitFileCode = ();
$FH = Symbol::gensym();
- $proto_re = "[" . quotemeta('\$%&*@;[]_') . "]" ;
+ $proto_re = "[" . quotemeta('\$%&*@;[]_') . "]";
$Overload = 0;
$errors = 0;
$Fallback = '&PL_sv_undef';
push @tm, standard_typemap_locations();
foreach my $typemap (@tm) {
- next unless -f $typemap ;
+ next unless -f $typemap;
# skip directories, binary files etc.
warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
- unless -T $typemap ;
+ unless -T $typemap;
open(TYPEMAP, $typemap)
or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
my $mode = 'Typemap';
- my $junk = "" ;
+ my $junk = "";
my $current = \$junk;
while (<TYPEMAP>) {
next if /^\s* #/;
}
if ($mode eq 'Typemap') {
chomp;
- my $line = $_ ;
- TrimWhitespace($_) ;
+ my $line = $_;
+ TrimWhitespace($_);
# skip blank lines and comment lines
- next if /^$/ or /^#/ ;
+ next if /^$/ or /^#/;
my($type,$kind, $proto) = /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/ or
warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 or 3 columns\n"), next;
- $type = TidyType($type) ;
- $type_kind{$type} = $kind ;
+ $type = TidyType($type);
+ $type_kind{$type} = $kind;
# prototype defaults to '$'
- $proto = "\$" unless $proto ;
+ $proto = "\$" unless $proto;
warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n")
- unless ValidProtoString($proto) ;
- $proto_letter{$type} = C_string($proto) ;
+ unless ValidProtoString($proto);
+ $proto_letter{$type} = C_string($proto);
} elsif (/^\s/) {
$$current .= $_;
} elsif ($mode eq 'Input') {
# Group in C (no support for comments or literals)
$C_group_rex = qr/ [({\[]
(?: (?> [^()\[\]{}]+ ) | (??{ $C_group_rex }) )*
- [)}\]] /x ;
+ [)}\]] /x;
# Chunk in C without comma at toplevel (no comments):
$C_arg = qr/ (?: (?> [^()\[\]{},"']+ )
| (??{ $C_group_rex })
)* /xs;
# Identify the version of xsubpp used
- print <<EOM ;
+ print <<EOM;
/*
* This file was venerated automatically by ExtUtils::ParseXS version $VERSION from the
* contents of $filename. Do not edit this file, edit $filename instead.
undef(%args_match);
undef(%var_types);
undef(%defaults);
- undef(%arg_list) ;
- undef(@proto_arg) ;
- undef($processing_arg_with_types) ;
- undef(%argtype_seen) ;
- undef(@outlist) ;
- undef(%in_out) ;
- undef(%lengthof) ;
- undef($proto_in_this_xsub) ;
- undef($scope_in_this_xsub) ;
+ undef(%arg_list);
+ undef(@proto_arg);
+ undef($processing_arg_with_types);
+ undef(%argtype_seen);
+ undef(@outlist);
+ undef(%in_out);
+ undef(%lengthof);
+ undef($proto_in_this_xsub);
+ undef($scope_in_this_xsub);
undef($interface);
undef($prepush_done);
- $interface_macro = 'XSINTERFACE_FUNC' ;
- $interface_macro_set = 'XSINTERFACE_FUNC_SET' ;
- $ProtoThisXSUB = $WantPrototypes ;
+ $interface_macro = 'XSINTERFACE_FUNC';
+ $interface_macro_set = 'XSINTERFACE_FUNC_SET';
+ $ProtoThisXSUB = $WantPrototypes;
$ScopeThisXSUB = 0;
$xsreturn = 0;
$_ = shift(@line);
while (my $kwd = check_keyword("REQUIRE|PROTOTYPES|FALLBACK|VERSIONCHECK|INCLUDE(?:_COMMAND)?|SCOPE")) {
- &{"${kwd}_handler"}() ;
- next PARAGRAPH unless @line ;
+ &{"${kwd}_handler"}();
+ next PARAGRAPH unless @line;
$_ = shift(@line);
}
&check_cpp;
push (@BootCode, "#line $line_no[@line_no - @line] \"$filepathname\"")
if $WantLineNumbers && $line[0] !~ /^\s*#\s*line\b/;
- push (@BootCode, @line, "") ;
- next PARAGRAPH ;
+ push (@BootCode, @line, "");
+ next PARAGRAPH;
}
# a function definition needs at least 2 lines
blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH
- unless @line ;
+ unless @line;
$externC = 1 if $ret_type =~ s/^extern "C"\s+//;
$static = 1 if $ret_type =~ s/^static\s+//;
blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH
unless $func_header =~ /^(?:([\w:]*)::)?(\w+)\s*\(\s*(.*?)\s*\)\s*(const)?\s*(;\s*)?$/s;
- ($class, $func_name, $orig_args) = ($1, $2, $3) ;
+ ($class, $func_name, $orig_args) = ($1, $2, $3);
$class = "$4 $class" if $4;
($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/;
($clean_func_name = $func_name) =~ s/^$Prefix//;
Warn("Warning: duplicate function definition '$clean_func_name' detected");
last;
}
- $XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ;
+ $XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++;
%XsubAliases = %XsubAliasValues = %Interfaces = @Attributes = ();
$DoSetMagic = 1;
$defaults{$args[$i]} = $2;
$defaults{$args[$i]} =~ s/"/\\"/g;
}
- $proto_arg[$i+1] = '$' ;
+ $proto_arg[$i+1] = '$';
}
$min_args = $num_args - $extra_args;
$report_args =~ s/"/\\"/g;
# dXSARGS;
##endif
EOF
- print Q(<<"EOF") if $ALIAS ;
+ print Q(<<"EOF") if $ALIAS;
# dXSI32;
EOF
- print Q(<<"EOF") if $INTERFACE ;
+ print Q(<<"EOF") if $INTERFACE;
# dXSFUNCTION($ret_type);
EOF
if ($ellipsis) {
$thisdone = 0;
$retvaldone = 0;
$deferred = "";
- %arg_list = () ;
+ %arg_list = ();
$gotRETVAL = 0;
- INPUT_handler() ;
- process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|ATTRS|PROTOTYPE|SCOPE|OVERLOAD") ;
+ INPUT_handler();
+ process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|ATTRS|PROTOTYPE|SCOPE|OVERLOAD");
print Q(<<"EOF") if $ScopeThisXSUB;
# ENTER;
# do code
if (/^\s*NOT_IMPLEMENTED_YET/) {
print "\n\tPerl_croak(aTHX_ \"$pname: not implemented yet\");\n";
- $_ = '' ;
+ $_ = '';
} else {
if ($ret_type ne "void") {
print "\t" . &map_type($ret_type, 'RETVAL') . ";\n"
unshift @line, @fake_INPUT_pre, @fake_INPUT, $_;
$_ = "";
$processing_arg_with_types = 1;
- INPUT_handler() ;
+ INPUT_handler();
}
print $deferred;
- process_keyword("INIT|ALIAS|ATTRS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS|OVERLOAD") ;
+ process_keyword("INIT|ALIAS|ATTRS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS|OVERLOAD");
if (check_keyword("PPCODE")) {
print_section();
print "\tLEAVE;\n" if $ScopeThisXSUB;
print "\tPUTBACK;\n\treturn;\n";
} elsif (check_keyword("CODE")) {
- print_section() ;
+ print_section();
} elsif (defined($class) and $func_name eq "DESTROY") {
print "\n\t";
print "delete THIS;\n";
undef $RETVAL_code ; # code to set RETVAL (from OUTPUT section);
# $wantRETVAL set if 'RETVAL =' autogenerated
($wantRETVAL, $ret_type) = (0, 'void') if $RETVAL_no_return;
- undef %outargs ;
+ undef %outargs;
process_keyword("POSTCALL|OUTPUT|ALIAS|ATTRS|PROTOTYPE|OVERLOAD");
&generate_output($var_types{$_}, $args_match{$_}, $_, $DoSetMagic)
generate_output($var_types{$_}, $num++, $_, 0, 1) for @outlist;
# do cleanup
- process_keyword("CLEANUP|ALIAS|ATTRS|PROTOTYPE|OVERLOAD") ;
+ process_keyword("CLEANUP|ALIAS|ATTRS|PROTOTYPE|OVERLOAD");
print Q(<<"EOF") if $ScopeThisXSUB;
# ]]
#
EOF
- our $newXS = "newXS" ;
- our $proto = "" ;
+ our $newXS = "newXS";
+ our $proto = "";
# Build the prototype string for the xsub
if ($ProtoThisXSUB) {
my $s = ';';
if ($min_args < $num_args) {
$s = '';
- $proto_arg[$min_args] .= ";" ;
+ $proto_arg[$min_args] .= ";";
}
push @proto_arg, "$s\@"
- if $ellipsis ;
+ if $ellipsis;
$proto = join ("", grep defined, @proto_arg);
}
if (%XsubAliases) {
$XsubAliases{$pname} = 0
- unless defined $XsubAliases{$pname} ;
+ unless defined $XsubAliases{$pname};
while ( ($name, $value) = each %XsubAliases) {
push(@InitFileCode, Q(<<"EOF"));
# cv = ${newXS}(\"$name\", XS_$Full_func_name, file$proto);
-# XSANY.any_i32 = $value ;
+# XSANY.any_i32 = $value;
EOF
}
}
$name = "$Package\::$name" unless $name =~ /::/;
push(@InitFileCode, Q(<<"EOF"));
# cv = ${newXS}(\"$name\", XS_$Full_func_name, file$proto);
-# $interface_macro_set(cv,$value) ;
+# $interface_macro_set(cv,$value);
EOF
}
}
# PERL_UNUSED_VAR(items); /* -W */
EOF
- print Q(<<"EOF") if $WantVersionChk ;
-# XS_VERSION_BOOTCHECK ;
+ print Q(<<"EOF") if $WantVersionChk;
+# XS_VERSION_BOOTCHECK;
#
EOF
- print Q(<<"EOF") if defined $XsubAliases or defined $Interfaces ;
+ print Q(<<"EOF") if defined $XsubAliases or defined $Interfaces;
# {
-# CV * cv ;
+# CV * cv;
#
EOF
print @InitFileCode;
- print Q(<<"EOF") if defined $XsubAliases or defined $Interfaces ;
+ print Q(<<"EOF") if defined $XsubAliases or defined $Interfaces;
# }
EOF
if (@BootCode)
{
- print "\n /* Initialisation Section */\n\n" ;
+ print "\n /* Initialisation Section */\n\n";
@line = @BootCode;
print_section();
- print "\n /* End of Initialisation Section */\n\n" ;
+ print "\n /* End of Initialisation Section */\n\n";
}
print Q(<<'EOF');
EOF
warn("Please specify prototyping behavior for $filename (see perlxs manual)\n")
- unless $ProtoUsed ;
+ unless $ProtoUsed;
chdir($orig_cwd);
select($orig_fh);
sub TrimWhitespace
{
- $_[0] =~ s/^\s+|\s+$//go ;
+ $_[0] =~ s/^\s+|\s+$//go;
}
sub TidyType
{
- local ($_) = @_ ;
+ local ($_) = @_;
# rationalise any '*' by joining them into bunches and removing whitespace
s#\s*(\*+)\s*#$1#g;
- s#(\*+)# $1 #g ;
+ s#(\*+)# $1 #g;
# change multiple whitespace into a single space
- s/\s+/ /g ;
+ s/\s+/ /g;
# trim leading & trailing whitespace
- TrimWhitespace($_) ;
+ TrimWhitespace($_);
- $_ ;
+ $_;
}
# Input: ($_, @line) == unparsed input.
sub process_keyword($)
{
- my($pattern) = @_ ;
- my $kwd ;
+ my($pattern) = @_;
+ my $kwd;
&{"${kwd}_handler"}()
- while $kwd = check_keyword($pattern) ;
+ while $kwd = check_keyword($pattern);
}
sub CASE_handler {
$cond = $_;
TrimWhitespace($cond);
print " ", ($condnum++ ? " else" : ""), ($cond ? " if ($cond)\n" : "\n");
- $_ = '' ;
+ $_ = '';
}
sub INPUT_handler {
last if /^\s*NOT_IMPLEMENTED_YET/;
next unless /\S/; # skip blank lines
- TrimWhitespace($_) ;
- my $line = $_ ;
+ TrimWhitespace($_);
+ my $line = $_;
# remove trailing semicolon if no initialisation
- s/\s*;$//g unless /[=;+].*\S/ ;
+ s/\s*;$//g unless /[=;+].*\S/;
# Process the length(foo) declarations
if (s/^([^=]*)\blength\(\s*(\w+)\s*\)\s*$/$1 XSauto_length_of_$2=NO_INIT/x) {
}
# check for optional initialisation code
- my $var_init = '' ;
- $var_init = $1 if s/\s*([=;+].*)$//s ;
+ my $var_init = '';
+ $var_init = $1 if s/\s*([=;+].*)$//s;
$var_init =~ s/"/\\"/g;
s/\s+/ /g;
$var_num = $args_match{$var_name};
$proto_arg[$var_num] = ProtoString($var_type)
- if $var_num ;
+ 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/
$DoSetMagic = ($1 eq "ENABLE" ? 1 : 0);
next;
}
- my ($outarg, $outcode) = /^\s*(\S+)\s*(.*?)\s*$/s ;
+ my ($outarg, $outcode) = /^\s*(\S+)\s*(.*?)\s*$/s;
blurt ("Error: duplicate OUTPUT argument '$outarg' ignored"), next
- if $outargs{$outarg} ++ ;
+ if $outargs{$outarg} ++;
if (!$gotRETVAL and $outarg eq 'RETVAL') {
# deal with RETVAL last
- $RETVAL_code = $outcode ;
- $gotRETVAL = 1 ;
- next ;
+ $RETVAL_code = $outcode;
+ $gotRETVAL = 1;
+ next;
}
blurt ("Error: OUTPUT $outarg not an argument"), next
unless defined($args_match{$outarg});
blurt("Error: No input definition for OUTPUT argument '$outarg' - ignored"), next
- unless defined $var_types{$outarg} ;
+ unless defined $var_types{$outarg};
$var_num = $args_match{$outarg};
if ($outcode) {
print "\t$outcode\n";
sub GetAliases
{
- my ($line) = @_ ;
- my ($orig) = $line ;
- my ($alias) ;
- my ($value) ;
+ my ($line) = @_;
+ my ($orig) = $line;
+ my ($alias);
+ my ($value);
# Parse alias definitions
# format is
# alias = value alias = value ...
while ($line =~ s/^\s*([\w:]+)\s*=\s*(\w+)\s*//) {
- $alias = $1 ;
- $orig_alias = $alias ;
- $value = $2 ;
+ $alias = $1;
+ $orig_alias = $alias;
+ $value = $2;
# check for optional package definition in the alias
- $alias = $Packprefix . $alias if $alias !~ /::/ ;
+ $alias = $Packprefix . $alias if $alias !~ /::/;
# check for duplicate alias name & duplicate value
Warn("Warning: Ignoring duplicate alias '$orig_alias'")
- if defined $XsubAliases{$alias} ;
+ if defined $XsubAliases{$alias};
Warn("Warning: Aliases '$orig_alias' and '$XsubAliasValues{$value}' have identical values")
- if $XsubAliasValues{$value} ;
+ if $XsubAliasValues{$value};
$XsubAliases = 1;
- $XsubAliases{$alias} = $value ;
- $XsubAliasValues{$value} = $orig_alias ;
+ $XsubAliases{$alias} = $value;
+ $XsubAliasValues{$value} = $orig_alias;
}
blurt("Error: Cannot parse ALIAS definitions from '$orig'")
- if $line ;
+ if $line;
}
sub ATTRS_handler ()
{
for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
next unless /\S/;
- TrimWhitespace($_) ;
+ TrimWhitespace($_);
push @Attributes, $_;
}
}
{
for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
next unless /\S/;
- TrimWhitespace($_) ;
- GetAliases($_) if $_ ;
+ TrimWhitespace($_);
+ GetAliases($_) if $_;
}
}
{
for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
next unless /\S/;
- TrimWhitespace($_) ;
+ TrimWhitespace($_);
while ( s/^\s*([\w:"\\)\+\-\*\/\%\<\>\.\&\|\^\!\~\{\}\=]+)\s*//) {
$Overload = 1 unless $Overload;
- my $overload = "$Package\::(".$1 ;
+ my $overload = "$Package\::(".$1;
push(@InitFileCode,
" (void)${newXS}(\"$overload\", XS_$Full_func_name, file$proto);\n");
}
# the rest of the current line should contain either TRUE,
# FALSE or UNDEF
- TrimWhitespace($_) ;
+ TrimWhitespace($_);
my %map = (
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 $_} ;
+ death ("Error: FALLBACK: TRUE/FALSE/UNDEF") unless exists $map{uc $_};
- $Fallback = $map{uc $_} ;
+ $Fallback = $map{uc $_};
}
sub REQUIRE_handler ()
{
# the rest of the current line should contain a version number
- my ($Ver) = $_ ;
+ my ($Ver) = $_;
- TrimWhitespace($Ver) ;
+ TrimWhitespace($Ver);
death ("Error: REQUIRE expects a version number")
- unless $Ver ;
+ unless $Ver;
# check that the version number is of the form n.n
death ("Error: REQUIRE: expected a number, got '$Ver'")
- unless $Ver =~ /^\d+(\.\d*)?/ ;
+ unless $Ver =~ /^\d+(\.\d*)?/;
death ("Error: xsubpp $Ver (or better) required--this is only $VERSION.")
- unless $VERSION >= $Ver ;
+ unless $VERSION >= $Ver;
}
sub VERSIONCHECK_handler ()
# the rest of the current line should contain either ENABLE or
# DISABLE
- TrimWhitespace($_) ;
+ TrimWhitespace($_);
# check for ENABLE/DISABLE
death ("Error: VERSIONCHECK: ENABLE/DISABLE")
- unless /^(ENABLE|DISABLE)/i ;
+ unless /^(ENABLE|DISABLE)/i;
- $WantVersionChk = 1 if $1 eq 'ENABLE' ;
- $WantVersionChk = 0 if $1 eq 'DISABLE' ;
+ $WantVersionChk = 1 if $1 eq 'ENABLE';
+ $WantVersionChk = 0 if $1 eq 'DISABLE';
}
sub PROTOTYPE_handler ()
{
- my $specified ;
+ my $specified;
death("Error: Only 1 PROTOTYPE definition allowed per xsub")
- if $proto_in_this_xsub ++ ;
+ if $proto_in_this_xsub ++;
for (; !/^$BLOCK_re/o; $_ = shift(@line)) {
next unless /\S/;
- $specified = 1 ;
- TrimWhitespace($_) ;
+ $specified = 1;
+ TrimWhitespace($_);
if ($_ eq 'DISABLE') {
$ProtoThisXSUB = 0
} elsif ($_ eq 'ENABLE') {
$ProtoThisXSUB = 1
} else {
# remove any whitespace
- s/\s+//g ;
+ s/\s+//g;
death("Error: Invalid prototype '$_'")
- unless ValidProtoString($_) ;
- $ProtoThisXSUB = C_string($_) ;
+ unless ValidProtoString($_);
+ $ProtoThisXSUB = C_string($_);
}
}
# If no prototype specified, then assume empty prototype ""
- $ProtoThisXSUB = 2 unless $specified ;
+ $ProtoThisXSUB = 2 unless $specified;
- $ProtoUsed = 1 ;
+ $ProtoUsed = 1;
}
sub SCOPE_handler ()
{
death("Error: Only 1 SCOPE declaration allowed per xsub")
- if $scope_in_this_xsub ++ ;
+ if $scope_in_this_xsub ++;
TrimWhitespace($_);
death ("Error: SCOPE: ENABLE/DISABLE")
# the rest of the current line should contain either ENABLE or
# DISABLE
- TrimWhitespace($_) ;
+ TrimWhitespace($_);
# check for ENABLE/DISABLE
death ("Error: PROTOTYPES: ENABLE/DISABLE")
- unless /^(ENABLE|DISABLE)/i ;
+ unless /^(ENABLE|DISABLE)/i;
- $WantPrototypes = 1 if $1 eq 'ENABLE' ;
- $WantPrototypes = 0 if $1 eq 'DISABLE' ;
- $ProtoUsed = 1 ;
+ $WantPrototypes = 1 if $1 eq 'ENABLE';
+ $WantPrototypes = 0 if $1 eq 'DISABLE';
+ $ProtoUsed = 1;
}
Handle => $FH,
IsPipe => scalar($filename =~ /\|\s*$/),
%args,
- }) ;
+ });
}
{
# the rest of the current line should contain a valid filename
- TrimWhitespace($_) ;
+ TrimWhitespace($_);
death("INCLUDE: filename missing")
- unless $_ ;
+ unless $_;
death("INCLUDE: output pipe is illegal")
- if /^\s*\|/ ;
+ if /^\s*\|/;
# simple minded recursion detector
death("INCLUDE loop detected")
- if $IncludedFiles{$_} ;
+ if $IncludedFiles{$_};
- ++ $IncludedFiles{$_} unless /\|\s*$/ ;
+ ++ $IncludedFiles{$_} unless /\|\s*$/;
if (/\|\s*$/ && /^\s*perl\s/) {
Warn("The INCLUDE directive with a command is discouraged." .
$FH = Symbol::gensym();
# open the new file
- open ($FH, "$_") or death("Cannot open '$_': $!") ;
+ open ($FH, "$_") or death("Cannot open '$_': $!");
print Q(<<"EOF");
#
#
EOF
- $filename = $_ ;
+ $filename = $_;
$filepathname = File::Spec->catfile($dir, $filename);
# Prime the pump by reading the first
# skip leading blank lines
while (<$FH>) {
- last unless /^\s*$/ ;
+ last unless /^\s*$/;
}
- $lastline = $_ ;
- $lastline_no = $. ;
+ $lastline = $_;
+ $lastline_no = $.;
}
sub QuoteArgs {
{
# the rest of the current line should contain a valid command
- TrimWhitespace($_) ;
+ TrimWhitespace($_);
$_ = QuoteArgs($_) if $^O eq 'VMS';
death("INCLUDE_COMMAND: command missing")
- unless $_ ;
+ unless $_;
death("INCLUDE_COMMAND: pipes are illegal")
- if /^\s*\|/ or /\|\s*$/ ;
+ if /^\s*\|/ or /\|\s*$/;
PushXSStack( IsPipe => 1 );
# open the new file
open ($FH, "-|", "$_")
- or death("Cannot run command '$_' to include its output: $!") ;
+ or death("Cannot run command '$_' to include its output: $!");
print Q(<<"EOF");
#
#
EOF
- $filename = $_ ;
+ $filename = $_;
$filepathname = $filename;
$filepathname =~ s/\"/\\"/g;
# skip leading blank lines
while (<$FH>) {
- last unless /^\s*$/ ;
+ last unless /^\s*$/;
}
- $lastline = $_ ;
- $lastline_no = $. ;
+ $lastline = $_;
+ $lastline_no = $.;
}
sub PopFile()
{
- return 0 unless $XSStack[-1]{type} eq 'file' ;
+ return 0 unless $XSStack[-1]{type} eq 'file';
- my $data = pop @XSStack ;
- my $ThisFile = $filename ;
+ my $data = pop @XSStack;
+ my $ThisFile = $filename;
my $isPipe = $data->{IsPipe};
-- $IncludedFiles{$filename}
- unless $isPipe ;
+ unless $isPipe;
- close $FH ;
+ close $FH;
- $FH = $data->{Handle} ;
+ $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} } ;
+ $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 ;
+ -- $lastline_no;
+ print STDERR "Error reading from pipe '$ThisFile': $! in $filename, line $lastline_no\n" ;
+ exit 1;
}
print Q(<<"EOF");
#
EOF
- return 1 ;
+ return 1;
}
sub ValidProtoString ($)
{
- my($string) = @_ ;
+ my($string) = @_;
if ( $string =~ /^$proto_re+$/ ) {
- return $string ;
+ return $string;
}
- return 0 ;
+ return 0;
}
sub C_string ($)
{
- my($string) = @_ ;
+ my($string) = @_;
- $string =~ s[\\][\\\\]g ;
- $string ;
+ $string =~ s[\\][\\\\]g;
+ $string;
}
sub ProtoString ($)
{
- my ($type) = @_ ;
+ my ($type) = @_;
- $proto_letter{$type} or "\$" ;
+ $proto_letter{$type} or "\$";
}
sub check_cpp {
death ("Error: Unterminated `#if/#ifdef/#ifndef'")
if !defined $lastline && $XSStack[-1]{type} eq 'if';
@line = ();
- @line_no = () ;
+ @line_no = ();
return PopFile() if !defined $lastline;
if ($lastline =~
$Module = $1;
$Package = defined($2) ? $2 : ''; # keep -w happy
$Prefix = defined($3) ? $3 : ''; # keep -w happy
- $Prefix = quotemeta $Prefix ;
+ $Prefix = quotemeta $Prefix;
($Module_cname = $Module) =~ s/\W/_/g;
($Packid = $Package) =~ tr/:/_/;
$Packprefix = $Package;
$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) ;
+ push(@line_no, $lastline_no);
}
# Read next line and continuation lines
sub Warn
{
# work out the line number
- my $line_no = $line_no[@line_no - @line -1] ;
+ 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 @_ ;
+ Warn @_;
$errors ++
}
sub death
{
- Warn @_ ;
- exit 1 ;
+ Warn @_;
+ exit 1;
}
sub generate_init {
local($ntype);
local($tk);
- $type = TidyType($type) ;
+ $type = TidyType($type);
blurt("Error: '$type' not in typemap"), return
unless defined($type_kind{$type});
}
$type =~ tr/:/_/ unless $hiertype;
blurt("Error: No INPUT definition for type '$type', typekind '$type_kind{$type}' found"), return
- unless defined $input_expr{$tk} ;
+ unless defined $input_expr{$tk};
$expr = $input_expr{$tk};
if ($expr =~ /DO_ARRAY_ELEM/) {
blurt("Error: '$subtype' not in typemap"), return
unless defined($type_kind{$subtype});
blurt("Error: No INPUT definition for type '$subtype', typekind '$type_kind{$subtype}' found"), return
- unless defined $input_expr{$type_kind{$subtype}} ;
+ unless defined $input_expr{$type_kind{$subtype}};
$subexpr = $input_expr{$type_kind{$subtype}};
$subexpr =~ s/\$type/\$subtype/g;
$subexpr =~ s/ntype/subtype/g;
local($argoff) = $num - 1;
local($ntype);
- $type = TidyType($type) ;
+ $type = TidyType($type);
if ($type =~ /^array\(([^,]*),(.*)\)/) {
print "\t$arg = sv_newmortal();\n";
print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1));\n";
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
- unless defined $output_expr{$type_kind{$type}} ;
+ unless defined $output_expr{$type_kind{$type}};
($ntype = $type) =~ s/\s*\*/Ptr/g;
$ntype =~ s/\(\)//g;
($subtype = $ntype) =~ s/(?:Array)?(?:Ptr)?$//;
blurt("Error: '$subtype' not in typemap"), return
unless defined($type_kind{$subtype});
blurt("Error: No OUTPUT definition for type '$subtype', typekind '$type_kind{$subtype}' found"), return
- unless defined $output_expr{$type_kind{$subtype}} ;
+ unless defined $output_expr{$type_kind{$subtype}};
$subexpr = $output_expr{$type_kind{$subtype}};
$subexpr =~ s/ntype/subtype/g;
$subexpr =~ s/\$arg/ST(ix_$var)/g;
projects / platform / upstream / perl.git / commitdiff