summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/ExtUtils/Typemaps.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/ExtUtils/Typemaps.pm115
1 files changed, 88 insertions, 27 deletions
diff --git a/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps.pm b/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps.pm
index b9a43589488..8bc04af04c3 100644
--- a/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps.pm
+++ b/Master/tlpkg/tlperl/lib/ExtUtils/Typemaps.pm
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps;
use 5.006001;
use strict;
use warnings;
-our $VERSION = '3.19';
+our $VERSION = '3.24';
#use Carp qw(croak);
require ExtUtils::ParseXS;
@@ -23,7 +23,7 @@ ExtUtils::Typemaps - Read/Write/Modify Perl/XS typemap files
# $typemap = ExtUtils::Typemaps->new();
# alternatively create an in-memory typemap by parsing a string
# $typemap = ExtUtils::Typemaps->new(string => $sometypemap);
-
+
# add a mapping
$typemap->add_typemap(ctype => 'NV', xstype => 'T_NV');
$typemap->add_inputmap(
@@ -34,13 +34,13 @@ ExtUtils::Typemaps - Read/Write/Modify Perl/XS typemap files
);
$typemap->add_string(string => $typemapstring);
# will be parsed and merged
-
+
# remove a mapping (same for remove_typemap and remove_outputmap...)
$typemap->remove_inputmap(xstype => 'SomeType');
-
+
# save a typemap to a file
$typemap->write(file => 'anotherfile.map');
-
+
# merge the other typemap into this one
$typemap->merge(typemap => $another_typemap);
@@ -111,6 +111,7 @@ sub _init {
}
}
+
=head2 file
Get/set the file that the typemap is written to when the
@@ -344,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;
@@ -443,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;
@@ -860,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");
}
@@ -880,6 +881,84 @@ sub validate {
return 1;
}
+=head2 clone
+
+Creates and returns a clone of a full typemaps object.
+
+Takes named parameters: If C<shallow> is true,
+the clone will share the actual individual type/input/outputmap objects,
+but not share their storage. Use with caution. Without C<shallow>,
+the clone will be fully independent.
+
+=cut
+
+sub clone {
+ my $proto = shift;
+ my %args = @_;
+
+ my $self;
+ if ($args{shallow}) {
+ $self = bless( {
+ %$proto,
+ typemap_section => [@{$proto->{typemap_section}}],
+ typemap_lookup => {%{$proto->{typemap_lookup}}},
+ input_section => [@{$proto->{input_section}}],
+ input_lookup => {%{$proto->{input_lookup}}},
+ output_section => [@{$proto->{output_section}}],
+ output_lookup => {%{$proto->{output_lookup}}},
+ } => ref($proto) );
+ }
+ else {
+ $self = bless( {
+ %$proto,
+ typemap_section => [map $_->new, @{$proto->{typemap_section}}],
+ typemap_lookup => {%{$proto->{typemap_lookup}}},
+ input_section => [map $_->new, @{$proto->{input_section}}],
+ input_lookup => {%{$proto->{input_lookup}}},
+ output_section => [map $_->new, @{$proto->{output_section}}],
+ output_lookup => {%{$proto->{output_lookup}}},
+ } => ref($proto) );
+ }
+
+ 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;
@@ -970,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) {
@@ -1020,7 +1081,7 @@ Steffen Mueller C<<smueller@cpan.org>>
=head1 COPYRIGHT & LICENSE
-Copyright 2009, 2010, 2011, 2012 Steffen Mueller
+Copyright 2009, 2010, 2011, 2012, 2013 Steffen Mueller
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.