summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSteffen Mueller <smueller@cpan.org>2013-05-22 21:49:06 +0200
committerSteffen Mueller <smueller@cpan.org>2013-06-25 08:00:25 +0200
commitae7fdf584559a304eb5992a58cd58349cc7c58da (patch)
tree35b6fff8f7da2b6b7c030e9da3a52dd86402fece
parent9259b56b5391336070101bbd8811e94a7d5fa8dd (diff)
downloadperl-ae7fdf584559a304eb5992a58cd58349cc7c58da.tar.gz
EU::ParseXS: Attempt to canonicalize C++ types in tidy_type
Includes moving tidy_type to ExtUtils::Typemaps where it seems to belong. It's a pretty poor canonicalizer, but better than nothing!
-rw-r--r--dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm7
-rw-r--r--dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm41
-rw-r--r--dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm60
-rw-r--r--dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm2
-rw-r--r--dist/ExtUtils-ParseXS/t/103-tidy_type.t31
-rw-r--r--dist/ExtUtils-ParseXS/t/600-t-compat.t5
6 files changed, 61 insertions, 85 deletions
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
index ec8292e2fa..b95cde3af3 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
@@ -22,7 +22,6 @@ $VERSION = eval $VERSION if $VERSION =~ /_/;
use ExtUtils::ParseXS::Utilities qw(
standard_typemap_locations
trim_whitespace
- tidy_type
C_string
valid_proto_string
process_typemaps
@@ -334,7 +333,7 @@ EOM
}
# 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
@@ -1827,7 +1826,7 @@ sub generate_init {
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);
@@ -1936,7 +1935,7 @@ sub generate_output {
my $typemaps = $self->{typemap};
- $type = tidy_type($type);
+ $type = ExtUtils::Typemaps::tidy_type($type);
local $argsref->{type} = $type;
if ($type =~ /^array\(([^,]*),(.*)\)/) {
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
index dbb0cae5e9..17fb5f9bac 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
@@ -13,7 +13,6 @@ our (@ISA, @EXPORT_OK);
@EXPORT_OK = qw(
standard_typemap_locations
trim_whitespace
- tidy_type
C_string
valid_proto_string
process_typemaps
@@ -41,7 +40,6 @@ 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
@@ -175,45 +173,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
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
index fdcc38894c..812b8f5f26 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
@@ -345,7 +345,7 @@ sub remove_typemap {
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;
@@ -444,7 +444,7 @@ sub get_typemap {
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;
@@ -861,7 +861,7 @@ sub validate {
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");
}
@@ -923,6 +923,42 @@ sub clone {
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;
@@ -1013,24 +1049,6 @@ sub _parse {
}
# 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) {
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm
index c16eafd562..c8b27fa3a4 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps/Type.pm
@@ -53,7 +53,7 @@ sub new {
$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;
diff --git a/dist/ExtUtils-ParseXS/t/103-tidy_type.t b/dist/ExtUtils-ParseXS/t/103-tidy_type.t
index a043383637..771fd307b0 100644
--- a/dist/ExtUtils-ParseXS/t/103-tidy_type.t
+++ b/dist/ExtUtils-ParseXS/t/103-tidy_type.t
@@ -1,23 +1,24 @@
#!/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]'");
+}
diff --git a/dist/ExtUtils-ParseXS/t/600-t-compat.t b/dist/ExtUtils-ParseXS/t/600-t-compat.t
index 1f22e40e03..20f2ce07b2 100644
--- a/dist/ExtUtils-ParseXS/t/600-t-compat.t
+++ b/dist/ExtUtils-ParseXS/t/600-t-compat.t
@@ -11,7 +11,6 @@ use Test::More;
use ExtUtils::Typemaps;
use ExtUtils::ParseXS::Utilities qw(
C_string
- tidy_type
trim_whitespace
process_typemaps
);
@@ -94,7 +93,7 @@ foreach my $test (@tests) {
}
-# 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.
@@ -157,7 +156,7 @@ sub _process_single_typemap {
"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;