And by proxy, this had to be implemented in the three add_* methods.
Also adds more tests for merging with conflicts.
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
use File::Spec;
use lib qw( lib );
use ExtUtils::ParseXS::Constants ();
+require ExtUtils::Typemaps;
+
our (@ISA, @EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT_OK = qw(
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};
'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);
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};
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);
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};
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);
# 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;
use strict;
use warnings;
-use Test::More tests => 5;
+use Test::More tests => 15;
use ExtUtils::Typemaps;
use File::Spec;
use File::Temp;
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');
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');
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");
+}
+
+
+
--- /dev/null
+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);
--- /dev/null
+TYPEMAP
+double T_DIFFERENT
+
+INPUT
+T_DIFFERENT
+ $var = ($type)SvNV($arg);