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.

diff --git a/MANIFEST b/MANIFEST
index 06b6d29..d76508b 100644 (file)
--- 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 (file)
--- 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 (file)
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
@@ -129,21 +129,26 @@ Optional named arguments: C<replace =E<gt> 1> forces removal/replacement of
 existing C<TYPEMAP> entries of the same C<ctype>.
 
 As an alternative to the named parameters usage, you may pass in
-an C<ExtUtils::Typemaps::Type> object, a copy of which will be
-added to the typemap.
+an C<ExtUtils::Typemaps::Type> object as first argument, a copy of which will be
+added to the typemap. In that case, only the C<replace> 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<code> to associate with it for input.
 Optional named arguments: C<replace =E<gt> 1> forces removal/replacement of
 existing C<INPUT> entries of the same C<xstype>.
 
-You may pass in a single C<ExtUtils::Typemaps::InputMap> 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<ExtUtils::Typemaps::InputMap> object as first argument, a copy of which will be
+added to the typemap. In that case, only the C<replace> 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<add_inputmap>.
 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 (file)
--- 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 (file)
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 (file)
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);