Add test of EU::Typemap output against old ParseXS code

This is testing for string equivalency, not code equivalency. But it's
better than nothing.

diff --git a/MANIFEST b/MANIFEST
index 28cf4cd..50a1eb1 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3005,6 +3005,7 @@ dist/ExtUtils-ParseXS/t/510-t-bare.t                              ExtUtils::Typemaps tests
 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/600-t-compat.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

diff --git a/dist/ExtUtils-ParseXS/t/600-t-compat.t b/dist/ExtUtils-ParseXS/t/600-t-compat.t
new file mode 100644 (file)
index 0000000..cc623cd
--- /dev/null
+++ b/dist/ExtUtils-ParseXS/t/600-t-compat.t
@@ -0,0 +1,136 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+# This test is for making sure that the new EU::Typemaps
+# based typemap merging produces the same result as the old
+# EU::ParseXS code.
+
+use ExtUtils::Typemaps;
+use ExtUtils::ParseXS::Utilities qw(
+  C_string
+  tidy_type
+  trim_whitespace
+  process_typemaps
+);
+use ExtUtils::ParseXS::Constants;
+use File::Spec;
+
+my $path_prefix = File::Spec->catdir(-d 't' ? qw(t data) : qw(data));
+my @local_tmaps = (
+  File::Spec->catdir($path_prefix, "conflicting.typemap"),
+);
+
+SCOPE: {
+  no warnings 'redefine';
+  my @standard_typemap_locations = (
+    File::Spec->catdir($path_prefix, "other.typemap"),
+  );
+  sub ExtUtils::ParseXS::Utilities::standard_typemap_locations {
+    @standard_typemap_locations;
+  }
+  sub standard_typemap_locations {
+    @standard_typemap_locations;
+  }
+}
+
+my $res = [_process_typemaps([@local_tmaps], '.')];
+my $res_new = [process_typemaps([@local_tmaps], '.')];
+
+# Normalize trailing whitespace. Let's be that lenient, mkay?
+for ($res, $res_new) {
+  for ($_->[2], $_->[3]) {
+    for (values %$_) {
+      s/\s+\z//;
+    }
+  }
+}
+#use Data::Dumper; warn Dumper $res;
+#use Data::Dumper; warn Dumper $res_new;
+
+is_deeply($res_new, $res);
+
+sub _process_typemaps {
+  my ($tmap, $pwd) = @_;
+
+  my @tm = ref $tmap ? @{$tmap} : ($tmap);
+
+  foreach my $typemap (@tm) {
+    die "Can't find $typemap in $pwd\n" unless -r $typemap;
+  }
+
+  push @tm, standard_typemap_locations( \@INC );
+
+  my ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref)
+    = ( {}, {}, {}, {} );
+
+  foreach my $typemap (@tm) {
+    next unless -f $typemap;
+    # skip directories, binary files etc.
+    warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
+      unless -T $typemap;
+    ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref) =
+      _process_single_typemap( $typemap,
+        $type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref);
+  }
+  return ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref);
+}
+
+sub _process_single_typemap {
+  my ($typemap,
+    $type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref) = @_;
+  open my $TYPEMAP, '<', $typemap
+    or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
+  my $mode = 'Typemap';
+  my $junk = "";
+  my $current = \$junk;
+  while (<$TYPEMAP>) {
+    # skip comments
+    next if /^\s*#/;
+    if (/^INPUT\s*$/) {
+      $mode = 'Input';   $current = \$junk;  next;
+    }
+    if (/^OUTPUT\s*$/) {
+      $mode = 'Output';  $current = \$junk;  next;
+    }
+    if (/^TYPEMAP\s*$/) {
+      $mode = 'Typemap'; $current = \$junk;  next;
+    }
+    if ($mode eq 'Typemap') {
+      chomp;
+      my $logged_line = $_;
+      trim_whitespace($_);
+      # skip blank lines
+      next if /^$/;
+      my($type,$kind, $proto) =
+        m/^\s*(.*?\S)\s+(\S+)\s*($ExtUtils::ParseXS::Constants::PrototypeRegexp*)\s*$/
+          or warn(
+            "Warning: File '$typemap' Line $.  '$logged_line' " .
+            "TYPEMAP entry needs 2 or 3 columns\n"
+          ),
+          next;
+      $type = tidy_type($type);
+      $type_kind_ref->{$type} = $kind;
+      # prototype defaults to '$'
+      $proto = "\$" unless $proto;
+      $proto_letter_ref->{$type} = C_string($proto);
+    }
+    elsif (/^\s/) {
+      $$current .= $_;
+    }
+    elsif ($mode eq 'Input') {
+      s/\s+$//;
+      $input_expr_ref->{$_} = '';
+      $current = \$input_expr_ref->{$_};
+    }
+    else {
+      s/\s+$//;
+      $output_expr_ref->{$_} = '';
+      $current = \$output_expr_ref->{$_};
+    }
+  }
+  close $TYPEMAP;
+  return ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref);
+}