use ExtUtils::ParseXS::Utilities qw(
standard_typemap_locations
trim_whitespace
- tidy_type
C_string
valid_proto_string
process_typemaps
}
# extract return type, function name and arguments
- ($self->{ret_type}) = tidy_type($_);
+ ($self->{ret_type}) = ExtUtils::Typemaps::tidy_type($_);
my $RETVAL_no_return = 1 if $self->{ret_type} =~ s/^NO_OUTPUT\s+//;
# Allow one-line ANSI-like declaration
my $typemaps = $self->{typemap};
- $type = tidy_type($type);
+ $type = ExtUtils::Typemaps::tidy_type($type);
$self->report_typemap_failure($typemaps, $type), return
unless $typemaps->get_typemap(ctype => $type);
my $typemaps = $self->{typemap};
- $type = tidy_type($type);
+ $type = ExtUtils::Typemaps::tidy_type($type);
local $argsref->{type} = $type;
if ($type =~ /^array\(([^,]*),(.*)\)/) {
@EXPORT_OK = qw(
standard_typemap_locations
trim_whitespace
- tidy_type
C_string
valid_proto_string
process_typemaps
use ExtUtils::ParseXS::Utilities qw(
standard_typemap_locations
trim_whitespace
- tidy_type
C_string
valid_proto_string
process_typemaps
$_[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
my %args = @_;
$ctype = $args{ctype};
die("Need ctype argument") if not defined $ctype;
- $ctype = _tidy_type($ctype);
+ $ctype = tidy_type($ctype);
}
else {
$ctype = $_[0]->tidy_ctype;
my %args = @_;
my $ctype = $args{ctype};
die("Need ctype argument") if not defined $ctype;
- $ctype = _tidy_type($ctype);
+ $ctype = tidy_type($ctype);
my $index = $self->{typemap_lookup}{$ctype};
return() if not defined $index;
my %args = @_;
if ( exists $args{ctype}
- and exists $self->{typemap_lookup}{_tidy_type($args{ctype})} )
+ and exists $self->{typemap_lookup}{tidy_type($args{ctype})} )
{
die("Multiple definition of ctype '$args{ctype}' in TYPEMAP section");
}
return $self;
}
+=head2 tidy_type
+
+Function to (heuristically) canonicalize a C type. Works to some
+degree with C++ types.
+
+ $halfway_canonical_type = tidy_type($ctype);
+
+Moved from C<ExtUtils::ParseXS>.
+
+=cut
+
+sub tidy_type {
+ local $_ = shift;
+
+ # for templated C++ types, do some bit of flawed canonicalization
+ # wrt. templates at least
+ if (/[<>]/) {
+ s/\s*([<>])\s*/$1/g;
+ s/>>/> >/g;
+ }
+
+ # rationalise any '*' by joining them into bunches and removing whitespace
+ s#\s*(\*+)\s*#$1#g;
+ s#(\*+)# $1 #g ;
+
+ # trim leading & trailing whitespace
+ s/^\s+//; s/\s+$//;
+
+ # change multiple whitespace into a single space
+ s/\s+/ /g;
+
+ $_;
+}
+
+
+
sub _parse {
my $self = shift;
my $stringref = shift;
}
# taken from ExtUtils::ParseXS
-sub _tidy_type {
- local $_ = shift;
-
- # rationalise any '*' by joining them into bunches and removing whitespace
- s#\s*(\*+)\s*#$1#g;
- s#(\*+)# $1 #g ;
-
- # trim leading & trailing whitespace
- s/^\s+//; s/\s+$//;
-
- # change multiple whitespace into a single space
- s/\s+/ /g;
-
- $_;
-}
-
-
-# taken from ExtUtils::ParseXS
sub _valid_proto_string {
my $string = shift;
if ($string =~ /^$ExtUtils::ParseXS::Constants::PrototypeRegexp+$/o) {
$self->{xstype} = $args{xstype} if defined $args{xstype};
$self->{ctype} = $args{ctype} if defined $args{ctype};
- $self->{tidy_ctype} = ExtUtils::Typemaps::_tidy_type($self->{ctype});
+ $self->{tidy_ctype} = ExtUtils::Typemaps::tidy_type($self->{ctype});
$self->{proto} = $args{'prototype'} if defined $args{'prototype'};
return $self;
#!/usr/bin/perl
use strict;
use warnings;
-use Test::More tests => 3;
+use Test::More;
use lib qw( lib );
-use ExtUtils::ParseXS::Utilities qw(
- tidy_type
-);
-
-my $input;
+use ExtUtils::Typemaps;
-$input = ' * ** ';
-is( tidy_type($input), '***',
- "Got expected value for '$input'" );
+my @tests = (
+ [' * ** ', '***'],
+ [' * ** ', '***'],
+ [' * ** foobar * ', '*** foobar *'],
+ ['unsigned int', 'unsigned int'],
+ ['std::vector<int>', 'std::vector<int>'],
+ ['std::vector< unsigned int >', 'std::vector<unsigned int>'],
+ ['std::vector< vector<unsigned int> >', 'std::vector<vector<unsigned int> >'],
+ ['std::map< map <unsigned int, int>, int>', 'std::map<map<unsigned int, int>, int>'],
+);
-$input = ' * ** ';
-is( tidy_type($input), '***',
- "Got expected value for '$input'" );
+plan tests => scalar(@tests);
-$input = ' * ** foobar * ';
-is( tidy_type($input), '*** foobar *',
- "Got expected value for '$input'" );
+foreach my $test (@tests) {
+ is(ExtUtils::Typemaps::tidy_type($test->[0]), $test->[1], "Tidying '$test->[0]'");
+}
use ExtUtils::Typemaps;
use ExtUtils::ParseXS::Utilities qw(
C_string
- tidy_type
trim_whitespace
process_typemaps
);
}
-# The code below is a reproduction of what the pre-ExtUtils::Typemap
+# The code below is a reproduction of what the pre-ExtUtils::Typemaps
# typemap-parsing/handling code in ExtUtils::ParseXS looked like. For
# bug-compatibility, we want to produce the same data structures as that
# code as much as possible.
"TYPEMAP entry needs 2 or 3 columns\n"
),
next;
- $type = tidy_type($type);
+ $type = ExtUtils::Typemaps::tidy_type($type);
$type_kind_ref->{$type} = $kind;
# prototype defaults to '$'
$proto = "\$" unless $proto;
projects / platform / upstream / perl.git / commitdiff