Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
data	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
lib	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
001-basic.t	4.94 KB	-r--r--r--	2014-12-27 11:48
002-more.t	3.61 KB	-r--r--r--	2014-12-27 11:48
003-usage.t	2.65 KB	-r--r--r--	2014-12-27 11:48
101-standard_typemap_locations.t	1.14 KB	-r--r--r--	2014-12-27 11:48
102-trim_whitespace.t	613 B	-r--r--r--	2014-12-27 11:48
103-tidy_type.t	654 B	-r--r--r--	2014-12-27 11:48
104-map_type.t	2.21 KB	-r--r--r--	2014-12-27 11:48
105-valid_proto_string.t	837 B	-r--r--r--	2014-12-27 11:48
106-process_typemaps.t	1.36 KB	-r--r--r--	2014-12-27 11:48
108-map_type.t	377 B	-r--r--r--	2014-12-27 11:48
109-standard_XS_defs.t	588 B	-r--r--r--	2014-12-27 11:49
110-assign_func_args.t	1.34 KB	-r--r--r--	2014-12-27 11:48
111-analyze_preprocessor_statements.t	367 B	-r--r--r--	2014-12-27 11:48
112-set_cond.t	171 B	-r--r--r--	2014-12-27 11:48
113-check_cond_preproc_statements.t	4.43 KB	-r--r--r--	2014-12-27 11:48
114-blurt_death_Warn.t	2.77 KB	-r--r--r--	2014-12-27 11:48
115-avoid-noise.t	536 B	-r--r--r--	2014-12-27 11:48
501-t-compile.t	221 B	-r--r--r--	2014-12-27 11:48
510-t-bare.t	4.88 KB	-r--r--r--	2014-12-27 11:48
511-t-whitespace.t	886 B	-r--r--r--	2014-12-27 11:48
512-t-file.t	1.75 KB	-r--r--r--	2014-12-27 11:48
513-t-merge.t	3.44 KB	-r--r--r--	2014-12-27 11:48
514-t-embed.t	381 B	-r--r--r--	2014-12-27 11:48
515-t-cmd.t	1.99 KB	-r--r--r--	2014-12-27 11:48
516-t-clone.t	1.38 KB	-r--r--r--	2014-12-27 11:48
517-t-targetable.t	5.17 KB	-r--r--r--	2014-12-27 11:48
600-t-compat.t	4.83 KB	-r--r--r--	2014-12-27 11:48
XSInclude.xsh	85 B	-r--r--r--	2014-12-27 11:48
XSMore.xs	2.69 KB	-r--r--r--	2014-12-27 11:48
XSTest.pm	119 B	-r--r--r--	2014-12-27 11:48
XSTest.xs	1.2 KB	-r--r--r--	2014-12-27 11:48
XSUsage.pm	117 B	-r--r--r--	2014-12-27 11:48
XSUsage.xs	1.02 KB	-r--r--r--	2014-12-27 11:48
XSWarn.xs	219 B	-r--r--r--	2014-12-27 11:48
pseudotypemap1	130 B	-r--r--r--	2014-12-27 11:48
typemap	7.45 KB	-r--r--r--	2014-12-27 11:48

Rename

#!/usr/bin/perl
use strict;
use warnings;

use Test::More;

# 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
  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 @tests = (
  {
    name => 'Simple conflict',
    local_maps => [
      File::Spec->catfile($path_prefix, "conflicting.typemap"),
    ],
    std_maps => [
      File::Spec->catfile($path_prefix, "other.typemap"),
    ],
  },
  {
    name => 'B',
    local_maps => [
      File::Spec->catfile($path_prefix, "b.typemap"),
    ],
    std_maps => [],
  },
  {
    name => 'B and perl',
    local_maps => [
      File::Spec->catfile($path_prefix, "b.typemap"),
    ],
    std_maps => [
      File::Spec->catfile($path_prefix, "perl.typemap"),
    ],
  },
  {
    name => 'B and perl and B again',
    local_maps => [
      File::Spec->catfile($path_prefix, "b.typemap"),
    ],
    std_maps => [
      File::Spec->catfile($path_prefix, "perl.typemap"),
      File::Spec->catfile($path_prefix, "b.typemap"),
    ],
  },
);
plan tests => scalar(@tests);

my @local_tmaps;
my @standard_typemap_locations;
SCOPE: {
  no warnings 'redefine';
  sub ExtUtils::ParseXS::Utilities::standard_typemap_locations {
    @standard_typemap_locations;
  }
  sub standard_typemap_locations {
    @standard_typemap_locations;
  }
}

foreach my $test (@tests) {
  @local_tmaps = @{ $test->{local_maps} };
  @standard_typemap_locations = @{ $test->{std_maps} };

my $res = [_process_typemaps([@local_tmaps], '.')];
  my $tm = process_typemaps([@local_tmaps], '.');
  my $res_new = [map $tm->$_(), qw(_get_typemap_hash _get_prototype_hash _get_inputmap_hash _get_outputmap_hash) ];

# 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, "typemap equivalency for '$test->{name}'");
}

# The code below is a reproduction of what the pre-ExtUtils::Typemaps
# typemap-parsing/handling code in ExtUtils::ParseXS looked like. For
# bug-compatibility, we want to produce the same data structures as that
# code as much as possible.
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 = ExtUtils::Typemaps::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);
}