diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/ExtUtils/Typemaps.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/ExtUtils/Typemaps.pm | 115 |
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. |