From 8226b442f3c07b0fedbfbf550f750c112e4392a8 Mon Sep 17 00:00:00 2001 From: Steffen Mueller Date: Fri, 11 Feb 2011 17:20:17 +0100 Subject: [PATCH] Implement 'replace' option when merging typemaps And by proxy, this had to be implemented in the three add_* methods. Also adds more tests for merging with conflicts. --- MANIFEST | 2 + .../lib/ExtUtils/ParseXS/Utilities.pm | 2 + dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm | 62 ++++++++++++--------- dist/ExtUtils-ParseXS/t/513-t-merge.t | 65 ++++++++++++++++++++-- dist/ExtUtils-ParseXS/t/data/confl_repl.typemap | 12 ++++ dist/ExtUtils-ParseXS/t/data/conflicting.typemap | 6 ++ 6 files changed, 119 insertions(+), 30 deletions(-) create mode 100644 dist/ExtUtils-ParseXS/t/data/confl_repl.typemap create mode 100644 dist/ExtUtils-ParseXS/t/data/conflicting.typemap diff --git a/MANIFEST b/MANIFEST index 06b6d29..d76508b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3006,6 +3006,8 @@ dist/ExtUtils-ParseXS/t/511-t-whitespace.t ExtUtils::Typemaps tests dist/ExtUtils-ParseXS/t/512-t-file.t ExtUtils::Typemaps tests dist/ExtUtils-ParseXS/t/513-t-merge.t ExtUtils::Typemaps tests dist/ExtUtils-ParseXS/t/data/combined.typemap ExtUtils::Typemaps test data +dist/ExtUtils-ParseXS/t/data/conflicting.typemap ExtUtils::Typemaps test data +dist/ExtUtils-ParseXS/t/data/confl_repl.typemap ExtUtils::Typemaps test data dist/ExtUtils-ParseXS/t/data/other.typemap ExtUtils::Typemaps test data dist/ExtUtils-ParseXS/t/data/simple.typemap ExtUtils::Typemaps test data dist/ExtUtils-ParseXS/t/lib/IncludeTester.pm ExtUtils::ParseXS testing utility diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm index b6e36c5..8412056 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm @@ -5,6 +5,8 @@ use Exporter; use File::Spec; use lib qw( lib ); use ExtUtils::ParseXS::Constants (); +require ExtUtils::Typemaps; + our (@ISA, @EXPORT_OK); @ISA = qw(Exporter); @EXPORT_OK = qw( diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm index 55ad939..3985b26 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm @@ -129,21 +129,26 @@ Optional named arguments: C 1> forces removal/replacement of existing C entries of the same C. As an alternative to the named parameters usage, you may pass in -an C object, a copy of which will be -added to the typemap. +an C object as first argument, a copy of which will be +added to the typemap. In that case, only the C named parameter +may be used after the object. Example: + + $map->add_typemap($type_obj, replace => 1); =cut sub add_typemap { my $self = shift; my $type; - my $replace = 0; - if (@_ == 1) { + my %args; + + if ((@_ % 2) == 1) { my $orig = shift; - $type = $orig->new(@_); + $type = $orig->new(); + %args = @_; } else { - my %args = @_; + %args = @_; my $ctype = $args{ctype}; croak("Need ctype argument") if not defined $ctype; my $xstype = $args{xstype}; @@ -154,10 +159,9 @@ sub add_typemap { 'prototype' => $args{'prototype'}, ctype => $ctype, ); - $replace = $args{replace}; } - if ($replace) { + if ($args{replace}) { $self->remove_typemap(ctype => $type->ctype); } else { $self->validate(typemap_xstype => $type->xstype, ctype => $type->ctype); @@ -182,21 +186,27 @@ and the C to associate with it for input. Optional named arguments: C 1> forces removal/replacement of existing C entries of the same C. -You may pass in a single C object instead, -a copy of which will be added to the typemap. +As an alternative to the named parameters usage, you may pass in +an C object as first argument, a copy of which will be +added to the typemap. In that case, only the C named parameter +may be used after the object. Example: + + $map->add_inputmap($type_obj, replace => 1); =cut sub add_inputmap { my $self = shift; my $input; - my $replace = 0; - if (@_ == 1) { + my %args; + + if ((@_ % 2) == 1) { my $orig = shift; - $input = $orig->new(@_); + $input = $orig->new(); + %args = @_; } else { - my %args = @_; + %args = @_; my $xstype = $args{xstype}; croak("Need xstype argument") if not defined $xstype; my $code = $args{code}; @@ -206,9 +216,9 @@ sub add_inputmap { xstype => $xstype, code => $code, ); - $replace = $args{replace}; } - if ($replace) { + + if ($args{replace}) { $self->remove_inputmap(xstype => $input->xstype); } else { $self->validate(inputmap_xstype => $input->xstype); @@ -232,13 +242,15 @@ Works exactly the same as C. sub add_outputmap { my $self = shift; my $output; - my $replace = 0; - if (@_ == 1) { + my %args; + + if ((@_ % 2) == 1) { my $orig = shift; - $output = $orig->new(@_); + $output = $orig->new(); + %args = @_; } else { - my %args = @_; + %args = @_; my $xstype = $args{xstype}; croak("Need xstype argument") if not defined $xstype; my $code = $args{code}; @@ -248,9 +260,9 @@ sub add_outputmap { xstype => $xstype, code => $code, ); - $replace = $args{replace}; } - if ($replace) { + + if ($args{replace}) { $self->remove_outputmap(xstype => $output->xstype); } else { $self->validate(outputmap_xstype => $output->xstype); @@ -543,15 +555,15 @@ sub merge { # FIXME breaking encapsulation. Add accessor code. # foreach my $entry (@{$typemap->{typemap_section}}) { - $self->add_typemap( $entry ); + $self->add_typemap( $entry, replace => $args{replace} ); } foreach my $entry (@{$typemap->{input_section}}) { - $self->add_inputmap( $entry ); + $self->add_inputmap( $entry, replace => $args{replace} ); } foreach my $entry (@{$typemap->{output_section}}) { - $self->add_outputmap( $entry ); + $self->add_outputmap( $entry, replace => $args{replace} ); } return 1; diff --git a/dist/ExtUtils-ParseXS/t/513-t-merge.t b/dist/ExtUtils-ParseXS/t/513-t-merge.t index 28e7f5f..bde8624 100644 --- a/dist/ExtUtils-ParseXS/t/513-t-merge.t +++ b/dist/ExtUtils-ParseXS/t/513-t-merge.t @@ -2,7 +2,7 @@ use strict; use warnings; -use Test::More tests => 5; +use Test::More tests => 15; use ExtUtils::Typemaps; use File::Spec; use File::Temp; @@ -17,11 +17,13 @@ sub slurp { return <$fh>; } -my $first_typemap_file = File::Spec->catfile($datadir, 'simple.typemap'); -my $second_typemap_file = File::Spec->catfile($datadir, 'other.typemap'); -my $combined_typemap_file = File::Spec->catfile($datadir, 'combined.typemap'); - +my $first_typemap_file = File::Spec->catfile($datadir, 'simple.typemap'); +my $second_typemap_file = File::Spec->catfile($datadir, 'other.typemap'); +my $combined_typemap_file = File::Spec->catfile($datadir, 'combined.typemap'); +my $conflicting_typemap_file = File::Spec->catfile($datadir, 'conflicting.typemap'); +my $confl_replace_typemap_file = File::Spec->catfile($datadir, 'confl_repl.typemap'); +# test merging two typemaps SCOPE: { my $first = ExtUtils::Typemaps->new(file => $first_typemap_file); isa_ok($first, 'ExtUtils::Typemaps'); @@ -33,6 +35,18 @@ SCOPE: { is($first->as_string(), slurp($combined_typemap_file), "merging produces expected output"); } +# test merging a typemap from file +SCOPE: { + my $first = ExtUtils::Typemaps->new(file => $first_typemap_file); + isa_ok($first, 'ExtUtils::Typemaps'); + + $first->merge(file => $second_typemap_file); + + is($first->as_string(), slurp($combined_typemap_file), "merging produces expected output"); +} + + +# test merging a typemap as string SCOPE: { my $first = ExtUtils::Typemaps->new(file => $first_typemap_file); isa_ok($first, 'ExtUtils::Typemaps'); @@ -42,3 +56,44 @@ SCOPE: { is($first->as_string(), slurp($combined_typemap_file), "merging (string) produces expected output"); } + +# test merging a conflicting typemap without "replace" +SCOPE: { + my $second = ExtUtils::Typemaps->new(file => $second_typemap_file); + isa_ok($second, 'ExtUtils::Typemaps'); + my $conflict = ExtUtils::Typemaps->new(file => $conflicting_typemap_file); + isa_ok($conflict, 'ExtUtils::Typemaps'); + + ok( + !eval { + $second->merge(typemap => $conflict); + 1; + }, + "Merging conflicting typemap croaks" + ); + ok( + $@ =~ /Multiple definition/, + "Conflicting typemap error as expected" + ); +} + +# test merging a conflicting typemap with "replace" +SCOPE: { + my $second = ExtUtils::Typemaps->new(file => $second_typemap_file); + isa_ok($second, 'ExtUtils::Typemaps'); + my $conflict = ExtUtils::Typemaps->new(file => $conflicting_typemap_file); + isa_ok($conflict, 'ExtUtils::Typemaps'); + + ok( + eval { + $second->merge(typemap => $conflict, replace => 1); + 1; + }, + "Conflicting typemap merge with replace doesn't croak" + ); + + is($second->as_string(), slurp($confl_replace_typemap_file), "merging (string) produces expected output"); +} + + + diff --git a/dist/ExtUtils-ParseXS/t/data/confl_repl.typemap b/dist/ExtUtils-ParseXS/t/data/confl_repl.typemap new file mode 100644 index 0000000..4aecbe8 --- /dev/null +++ b/dist/ExtUtils-ParseXS/t/data/confl_repl.typemap @@ -0,0 +1,12 @@ +TYPEMAP +double T_DIFFERENT + +INPUT +T_NV + $var = ($type)SvNV($arg); +T_DIFFERENT + $var = ($type)SvNV($arg); + +OUTPUT +T_NV + sv_setnv($arg, (NV)$var); diff --git a/dist/ExtUtils-ParseXS/t/data/conflicting.typemap b/dist/ExtUtils-ParseXS/t/data/conflicting.typemap new file mode 100644 index 0000000..3edee2d --- /dev/null +++ b/dist/ExtUtils-ParseXS/t/data/conflicting.typemap @@ -0,0 +1,6 @@ +TYPEMAP +double T_DIFFERENT + +INPUT +T_DIFFERENT + $var = ($type)SvNV($arg); -- 1.8.3.1