From c1e43162c66a1be88963cbbfc5c8ec016c9a1fcc Mon Sep 17 00:00:00 2001 From: "James E. Keenan" Date: Sat, 13 Mar 2010 22:02:23 -0500 Subject: [PATCH] Shuffle more functions and variables around Move sub C_string() to Utilities.pm. Eliminate some 'my' variables inside process_file() that can be handled equally well by %args elements. --- dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm | 51 +++++++++------------- .../lib/ExtUtils/ParseXS/Utilities.pm | 30 +++++++++++++ 2 files changed, 51 insertions(+), 30 deletions(-) diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm index 03a52be..fda7c25 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm @@ -14,6 +14,7 @@ use ExtUtils::ParseXS::Utilities qw( standard_typemap_locations trim_whitespace tidy_type + C_string ); our (@ISA, @EXPORT_OK, $VERSION); @@ -46,12 +47,12 @@ our ( sub process_file { # Allow for $package->process_file(%hash) in the future - my ($pkg, %args) = @_ % 2 ? @_ : (__PACKAGE__, @_); + my ($pkg, %options) = @_ % 2 ? @_ : (__PACKAGE__, @_); - $ProtoUsed = exists $args{prototypes}; + $ProtoUsed = exists $options{prototypes}; # Set defaults. - %args = ( + my %args = ( argtypes => 1, csuffix => '.c', except => 0, @@ -63,8 +64,9 @@ sub process_file { prototypes => 0, typemap => [], versioncheck => 1, - %args, + %options, ); + $args{except} = $args{except} ? ' TRY' : ''; # Global Constants @@ -92,19 +94,15 @@ sub process_file { $hiertype = $args{hiertype}; $WantPrototypes = $args{prototypes}; $WantVersionChk = $args{versioncheck}; - my $except = $args{except} ? ' TRY' : ''; $WantLineNumbers = $args{linenumbers}; - my $WantOptimize = $args{optimize}; - my $process_inout = $args{inout}; - my $process_argtypes = $args{argtypes}; my @tm = ref $args{typemap} ? @{$args{typemap}} : ($args{typemap}); - for ($args{filename}) { - die "Missing required parameter 'filename'" unless $_; - $filepathname = $_; - ($dir, $filename) = (dirname($_), basename($_)); + for my $f ($args{filename}) { + die "Missing required parameter 'filename'" unless $f; + $filepathname = $f; + ($dir, $filename) = (dirname($f), basename($f)); $filepathname =~ s/\\/\\\\/g; - $IncludedFiles{$_}++; + $IncludedFiles{$f}++; } # Open the input file @@ -485,7 +483,7 @@ EOF # Allow one-line ANSI-like declaration unshift @line, $2 - if $process_argtypes + if $args{argtypes} and $ret_type =~ s/^(.*?\w.*?)\s*\b(\w+\s*\(.*)/$1/s; # a function definition needs at least 2 lines @@ -523,7 +521,7 @@ EOF my @args; my %only_C_inlist; # Not in the signature of Perl function - if ($process_argtypes and $orig_args =~ /\S/) { + if ($args{argtypes} and $orig_args =~ /\S/) { my $args = "$orig_args ,"; if ($args =~ /^( (??{ $C_arg }) , )* $ /x) { @args = ($args =~ /\G ( (??{ $C_arg }) ) , /xg); @@ -537,7 +535,7 @@ EOF next unless defined($pre) && length($pre); my $out_type = ''; my $inout_var; - if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\b\s*//) { + if ($args{inout} and s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\b\s*//) { my $type = $1; $out_type = $type if $type ne 'IN'; $arg =~ s/^(IN|IN_OUTLIST|OUTLIST|OUT|IN_OUT)\b\s*//; @@ -574,7 +572,7 @@ EOF else { @args = split(/\s*,\s*/, $orig_args); for (@args) { - if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST|IN_OUT|OUT)\b\s*//) { + if ($args{inout} and s/^(IN|IN_OUTLIST|OUTLIST|IN_OUT|OUT)\b\s*//) { my $out_type = $1; next if $out_type eq 'IN'; $only_C_inlist{$_} = 1 if $out_type eq "OUTLIST"; @@ -669,7 +667,7 @@ EOF $cond = qq(items < $min_args || items > $num_args); } - print Q(<<"EOF") if $except; + print Q(<<"EOF") if $args{except}; # char errbuf[1024]; # *errbuf = '\0'; EOF @@ -711,7 +709,7 @@ EOF while (@line) { &CASE_handler if check_keyword("CASE"); print Q(<<"EOF"); -# $except [[ +# $args{except} [[ EOF # do initialization of input variables @@ -754,7 +752,7 @@ EOF $args_match{"RETVAL"} = 0; $var_types{"RETVAL"} = $ret_type; print "\tdXSTARG;\n" - if $WantOptimize and $targetable{$type_kind{$ret_type}}; + if $args{optimize} and $targetable{$type_kind{$ret_type}}; } if (@fake_INPUT or @fake_INPUT_pre) { @@ -825,7 +823,7 @@ EOF print "\t$RETVAL_code\n"; } elsif ($gotRETVAL || $wantRETVAL) { - my $t = $WantOptimize && $targetable{$type_kind{$ret_type}}; + my $t = $args{optimize} && $targetable{$type_kind{$ret_type}}; my $var = 'RETVAL'; my $type = $ret_type; @@ -877,7 +875,7 @@ EOF print Q(<<"EOF"); # ]] EOF - print Q(<<"EOF") if $except; + print Q(<<"EOF") if $args{except}; # BEGHANDLERS # CATCHALL # sprintf(errbuf, "%s: %s\\tpropagated", Xname, Xreason); @@ -893,7 +891,7 @@ EOF death(/^$BLOCK_re/o ? "Misplaced `$1:'" : "Junk at end of function ($_)"); } - print Q(<<"EOF") if $except; + print Q(<<"EOF") if $args{except}; # if (errbuf[0]) # Perl_croak(aTHX_ errbuf); EOF @@ -1647,13 +1645,6 @@ sub ValidProtoString ($) { return 0; } -sub C_string ($) { - my($string) = @_; - - $string =~ s[\\][\\\\]g; - $string; -} - sub ProtoString ($) { my ($type) = @_; diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm index 105568f..7ce3051 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm @@ -9,6 +9,7 @@ our (@ISA, @EXPORT_OK); standard_typemap_locations trim_whitespace tidy_type + C_string ); =head1 NAME @@ -178,4 +179,33 @@ sub tidy_type { $_; } +=head2 C + +=over 4 + +=item * Purpose + +Escape backslashes (C<\>) in prototype strings. + +=item * Arguments + + $ProtoThisXSUB = C_string($_); + +String needing escaping. + +=item * Return Value + +Properly escaped string. + +=back + +=cut + +sub C_string { + my($string) = @_; + + $string =~ s[\\][\\\\]g; + $string; +} + 1; -- 2.7.4