summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Utilities.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Utilities.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Utilities.pm166
1 files changed, 31 insertions, 135 deletions
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Utilities.pm b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Utilities.pm
index a847a14a409..ae384fd5b58 100644
--- a/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Utilities.pm
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/ParseXS/Utilities.pm
@@ -6,18 +6,16 @@ use File::Spec;
use lib qw( lib );
use ExtUtils::ParseXS::Constants ();
-our $VERSION = '3.19';
+our $VERSION = '3.24';
our (@ISA, @EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT_OK = qw(
standard_typemap_locations
trim_whitespace
- tidy_type
C_string
valid_proto_string
process_typemaps
- make_targetable
map_type
standard_XS_defs
assign_func_args
@@ -41,11 +39,9 @@ ExtUtils::ParseXS::Utilities - Subroutines used with ExtUtils::ParseXS
use ExtUtils::ParseXS::Utilities qw(
standard_typemap_locations
trim_whitespace
- tidy_type
C_string
valid_proto_string
process_typemaps
- make_targetable
map_type
standard_XS_defs
assign_func_args
@@ -129,26 +125,35 @@ Array holding list of directories to be searched for F<typemap> files.
=cut
-sub standard_typemap_locations {
- my $include_ref = shift;
- my @tm = qw(typemap);
-
- my $updir = File::Spec->updir();
- foreach my $dir (
- File::Spec->catdir(($updir) x 1),
- File::Spec->catdir(($updir) x 2),
- File::Spec->catdir(($updir) x 3),
- File::Spec->catdir(($updir) x 4),
- ) {
- unshift @tm, File::Spec->catfile($dir, 'typemap');
- unshift @tm, File::Spec->catfile($dir, lib => ExtUtils => 'typemap');
- }
- foreach my $dir (@{ $include_ref}) {
- my $file = File::Spec->catfile($dir, ExtUtils => 'typemap');
- unshift @tm, $file if -e $file;
+SCOPE: {
+ my @tm_template;
+
+ sub standard_typemap_locations {
+ my $include_ref = shift;
+
+ if (not @tm_template) {
+ @tm_template = qw(typemap);
+
+ my $updir = File::Spec->updir();
+ foreach my $dir (
+ File::Spec->catdir(($updir) x 1),
+ File::Spec->catdir(($updir) x 2),
+ File::Spec->catdir(($updir) x 3),
+ File::Spec->catdir(($updir) x 4),
+ ) {
+ unshift @tm_template, File::Spec->catfile($dir, 'typemap');
+ unshift @tm_template, File::Spec->catfile($dir, lib => ExtUtils => 'typemap');
+ }
+ }
+
+ my @tm = @tm_template;
+ foreach my $dir (@{ $include_ref}) {
+ my $file = File::Spec->catfile($dir, ExtUtils => 'typemap');
+ unshift @tm, $file if -e $file;
+ }
+ return @tm;
}
- return @tm;
-}
+} # end SCOPE
=head2 C<trim_whitespace()>
@@ -175,45 +180,6 @@ sub trim_whitespace {
$_[0] =~ s/^\s+|\s+$//go;
}
-=head2 C<tidy_type()>
-
-=over 4
-
-=item * Purpose
-
-Rationalize any asterisks (C<*>) by joining them into bunches, removing
-interior whitespace, then trimming leading and trailing whitespace.
-
-=item * Arguments
-
- ($ret_type) = tidy_type($_);
-
-String to be cleaned up.
-
-=item * Return Value
-
-String cleaned up.
-
-=back
-
-=cut
-
-sub tidy_type {
- local ($_) = @_;
-
- # 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;
-
- # trim leading & trailing whitespace
- trim_whitespace($_);
-
- $_;
-}
-
=head2 C<C_string()>
=over 4
@@ -266,7 +232,7 @@ Upon failure, returns C<0>.
=cut
sub valid_proto_string {
- my($string) = @_;
+ my ($string) = @_;
if ( $string =~ /^$ExtUtils::ParseXS::Constants::PrototypeRegexp+$/ ) {
return $string;
@@ -323,76 +289,6 @@ sub process_typemaps {
return $typemap;
}
-=head2 C<make_targetable()>
-
-=over 4
-
-=item * Purpose
-
-Populate C<%targetable>. This constitutes a refinement of the output of
-C<process_typemaps()> with respect to its fourth output, C<$output_expr_ref>.
-
-=item * Arguments
-
- %targetable = make_targetable($output_expr_ref);
-
-Single hash reference: the fourth such ref returned by C<process_typemaps()>.
-
-=item * Return Value
-
-Hash.
-
-=back
-
-=cut
-
-sub make_targetable {
- my $output_expr_ref = shift;
-
- our $bal; # ()-balanced
- $bal = qr[
- (?:
- (?>[^()]+)
- |
- \( (??{ $bal }) \)
- )*
- ]x;
-
- # matches variations on (SV*)
- my $sv_cast = qr[
- (?:
- \( \s* SV \s* \* \s* \) \s*
- )?
- ]x;
-
- my $size = qr[ # Third arg (to setpvn)
- , \s* (??{ $bal })
- ]x;
-
- my %targetable;
- foreach my $key (keys %{ $output_expr_ref }) {
- # We can still bootstrap compile 're', because in code re.pm is
- # available to miniperl, and does not attempt to load the XS code.
- use re 'eval';
-
- my ($type, $with_size, $arg, $sarg) =
- ($output_expr_ref->{$key} =~
- m[^
- \s+
- sv_set([iunp])v(n)? # Type, is_setpvn
- \s*
- \( \s*
- $sv_cast \$arg \s* , \s*
- ( (??{ $bal }) ) # Set from
- ( (??{ $size }) )? # Possible sizeof set-from
- \) \s* ; \s* $
- ]x
- );
- $targetable{$key} = [$type, $with_size, $arg, $sarg] if $type;
- }
- return %targetable;
-}
-
=head2 C<map_type()>
=over 4
@@ -419,7 +315,7 @@ sub map_type {
my ($self, $type, $varname) = @_;
# C++ has :: in types too so skip this
- $type =~ tr/:/_/ unless $self->{hiertype};
+ $type =~ tr/:/_/ unless $self->{RetainCplusplusHierarchicalTypes};
$type =~ s/^array\(([^,]*),(.*)\).*/$1 */s;
if ($varname) {
if ($type =~ / \( \s* \* (?= \s* \) ) /xg) {