Improve test coverage, extract function for better testing

Add files to test EU::PXS::Utilities::map_type(), valid_proto_string(),
process_typemaps().  Extract code for processing a single typemap file
into its own sub, thereby permitting more focused testing.  Eliminate some
unreachable branches and conditions in process_typemaps().

On the basis of coverage analysis, eliminate unreachable code.
Reformat some code for readability (shorter line length).

diff --git a/MANIFEST b/MANIFEST
index b835f72..f984a13 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2984,7 +2984,11 @@ dist/ExtUtils-ParseXS/t/003-usage.t                              ExtUtils::ParseXS tests
 dist/ExtUtils-ParseXS/t/101-standard_typemap_locations.t       ExtUtils::ParseXS tests
 dist/ExtUtils-ParseXS/t/102-trim_whitespace.t                  ExtUtils::ParseXS tests
 dist/ExtUtils-ParseXS/t/103-tidy_type.t                                ExtUtils::ParseXS tests
+dist/ExtUtils-ParseXS/t/104-map_type.t                         ExtUtils::ParseXS tests
+dist/ExtUtils-ParseXS/t/105-valid_proto_string.t               ExtUtils::ParseXS tests
+dist/ExtUtils-ParseXS/t/106-process_typemaps.t                 ExtUtils::ParseXS tests
 dist/ExtUtils-ParseXS/t/lib/IncludeTester.pm                   ExtUtils::ParseXS testing utility
+dist/ExtUtils-ParseXS/t/pseudotypemap1                         A test-typemap
 dist/ExtUtils-ParseXS/t/typemap                                        Standard typemap for controlled testing
 dist/ExtUtils-ParseXS/t/XSInclude.xsh                          Test file for ExtUtils::ParseXS tests
 dist/ExtUtils-ParseXS/t/XSMore.xs                              Test file for ExtUtils::ParseXS tests

diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
index 94f28bd..06efc6e 100644 (file)
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
@@ -14,6 +14,7 @@ our (@ISA, @EXPORT_OK);
   C_string
   valid_proto_string
   process_typemaps
+  process_single_typemap
   make_targetable
   map_type
 );
@@ -286,62 +287,80 @@ sub process_typemaps {
 
   push @tm, standard_typemap_locations( \@INC );
 
-  my (%type_kind, %proto_letter, %input_expr, %output_expr);
+  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;
-    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>) {
-      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 $line = $_;
-        trim_whitespace($_);
-        # skip blank lines and comment lines
-        next if /^$/ or /^#/;
-        my($type,$kind, $proto) = /^\s*(.*?\S)\s+(\S+)\s*($ExtUtils::ParseXS::Constants::proto_re*)\s*$/ or
-          warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 or 3 columns\n"), next;
-        $type = tidy_type($type);
-        $type_kind{$type} = $kind;
-        # prototype defaults to '$'
-        $proto = "\$" unless $proto;
-        warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n")
-          unless valid_proto_string($proto);
-        $proto_letter{$type} = C_string($proto);
-      }
-      elsif (/^\s/) {
-        $$current .= $_;
-      }
-      elsif ($mode eq 'Input') {
-        s/\s+$//;
-        $input_expr{$_} = '';
-        $current = \$input_expr{$_};
-      }
-      else {
-        s/\s+$//;
-        $output_expr{$_} = '';
-        $current = \$output_expr{$_};
-      }
+    ($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::proto_re*)\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;
+#      warn(
+#          "Warning: File '$typemap' Line $. '$logged_line' " .
+#          "Invalid prototype '$proto'\n"
+#      ) unless valid_proto_string($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, \%proto_letter, \%input_expr, \%output_expr);
+  close $TYPEMAP;
+  return ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref);
 }
 
 =head2 C<make_targetable()>

diff --git a/dist/ExtUtils-ParseXS/t/104-map_type.t b/dist/ExtUtils-ParseXS/t/104-map_type.t
new file mode 100644 (file)
index 0000000..2c5ae30
--- /dev/null
+++ b/dist/ExtUtils-ParseXS/t/104-map_type.t
@@ -0,0 +1,67 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More tests =>  7;
+use lib qw( lib );
+use ExtUtils::ParseXS::Utilities qw(
+  map_type
+);
+
+my ($type, $varname, $hiertype);
+my ($result, $expected);
+
+$type = 'struct DATA *';
+$varname = 'RETVAL';
+$hiertype = 0;
+$expected = "$type\t$varname";
+$result = map_type($type, $varname, $hiertype);
+is( $result, $expected,
+    "Got expected map_type for <$type>, <$varname>, <$hiertype>" );
+
+$type = 'Crypt::Shark';
+$varname = undef;
+$hiertype = 0;
+$expected = 'Crypt__Shark';
+$result = map_type($type, $varname, $hiertype);
+is( $result, $expected,
+    "Got expected map_type for <$type>, undef, <$hiertype>" );
+
+$type = 'Crypt::Shark';
+$varname = undef;
+$hiertype = 1;
+$expected = 'Crypt::Shark';
+$result = map_type($type, $varname, $hiertype);
+is( $result, $expected,
+    "Got expected map_type for <$type>, undef, <$hiertype>" );
+
+$type = 'Crypt::TC18';
+$varname = 'RETVAL';
+$hiertype = 0;
+$expected = "Crypt__TC18\t$varname";
+$result = map_type($type, $varname, $hiertype);
+is( $result, $expected,
+    "Got expected map_type for <$type>, <$varname>, <$hiertype>" );
+
+$type = 'Crypt::TC18';
+$varname = 'RETVAL';
+$hiertype = 1;
+$expected = "Crypt::TC18\t$varname";
+$result = map_type($type, $varname, $hiertype);
+is( $result, $expected,
+    "Got expected map_type for <$type>, <$varname>, <$hiertype>" );
+
+$type = 'array(alpha,beta) gamma';
+$varname = 'RETVAL';
+$hiertype = 0;
+$expected = "alpha *\t$varname";
+$result = map_type($type, $varname, $hiertype);
+is( $result, $expected,
+    "Got expected map_type for <$type>, <$varname>, <$hiertype>" );
+
+$type = '(*)';
+$varname = 'RETVAL';
+$hiertype = 0;
+$expected = "(* $varname )";
+$result = map_type($type, $varname, $hiertype);
+is( $result, $expected,
+    "Got expected map_type for <$type>, <$varname>, <$hiertype>" );

diff --git a/dist/ExtUtils-ParseXS/t/105-valid_proto_string.t b/dist/ExtUtils-ParseXS/t/105-valid_proto_string.t
new file mode 100644 (file)
index 0000000..2ba4e32
--- /dev/null
+++ b/dist/ExtUtils-ParseXS/t/105-valid_proto_string.t
@@ -0,0 +1,30 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Test::More tests =>  5;
+use lib qw( lib );
+use ExtUtils::ParseXS::Utilities qw(
+  valid_proto_string
+);
+
+my ($input, $output);
+
+$input = '[\$]';
+$output = valid_proto_string($input);
+is( $output, $input, "Got expected value for <$input>" );
+
+$input = '[$]';
+$output = valid_proto_string($input);
+is( $output, $input, "Got expected value for <$input>" );
+
+$input = '[\$\@]';
+$output = valid_proto_string($input);
+is( $output, $input, "Got expected value for <$input>" );
+
+$input = '[\$alpha]';
+$output = valid_proto_string($input);
+is( $output, 0, "Got expected value for <$input>" );
+
+$input = '[alpha]';
+$output = valid_proto_string($input);
+is( $output, 0, "Got expected value for <$input>" );

diff --git a/dist/ExtUtils-ParseXS/t/106-process_typemaps.t b/dist/ExtUtils-ParseXS/t/106-process_typemaps.t
new file mode 100644 (file)
index 0000000..520f0b5
--- /dev/null
+++ b/dist/ExtUtils-ParseXS/t/106-process_typemaps.t
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use Carp;
+use Cwd;
+use File::Spec;
+use File::Temp qw( tempdir );
+use Test::More tests =>  7;
+use lib qw( lib );
+use ExtUtils::ParseXS::Utilities qw(
+  process_typemaps
+  process_single_typemap
+);
+
+my $startdir  = cwd();
+{
+    my ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref);
+    my $typemap = 'typemap';
+    my $tdir = tempdir( CLEANUP => 1 );
+    chdir $tdir or croak "Unable to change to tempdir for testing";
+    eval {
+        ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref)
+            = process_typemaps( $typemap, $tdir );
+    };
+    like( $@, qr/Can't find $typemap in $tdir/, #'
+        "Got expected result for no typemap in current directory" );
+    chdir $startdir;
+}
+
+{
+    my ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref);
+    my $typemap = [ qw( pseudo typemap ) ];
+    my $tdir = tempdir( CLEANUP => 1 );
+    chdir $tdir or croak "Unable to change to tempdir for testing";
+    open my $IN, '>', 'typemap' or croak "Cannot open for writing";
+    print $IN "\n";
+    close $IN or croak "Cannot close after writing";
+    eval {
+        ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref)
+            = process_typemaps( $typemap, $tdir );
+    };
+    like( $@, qr/Can't find pseudo in $tdir/, #'
+        "Got expected result for no typemap in current directory" );
+    chdir $startdir;
+}
+
+{
+    my ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref);
+    my $typemap = File::Spec->catfile( qw| t pseudotypemap1 | );
+    my @capture = ();
+    local $SIG{__WARN__} = sub { push @capture, $_[0] };
+    ($type_kind_ref, $proto_letter_ref, $input_expr_ref, $output_expr_ref)
+            = process_single_typemap( $typemap, {}, {}, {}, {}  );
+    like( $capture[0],
+        qr/TYPEMAP entry needs 2 or 3 columns/,
+        "Got expected warning for insufficient columns"
+    );
+    my $t = 'unsigned long';
+    is( $type_kind_ref->{$t}, 'T_UV',
+        "type_kind:  got expected value for <$t>" );
+    is( $proto_letter_ref->{$t}, '$',
+        "proto_letter:  got expected value for <$t>" );
+    is( scalar keys %{ $input_expr_ref }, 0,
+        "Nothing assigned to input_expr" );
+    is( scalar keys %{ $output_expr_ref }, 0,
+        "Nothing assigned to output_expr" );
+}
+

diff --git a/dist/ExtUtils-ParseXS/t/pseudotypemap1 b/dist/ExtUtils-ParseXS/t/pseudotypemap1
new file mode 100644 (file)
index 0000000..de771bd
--- /dev/null
+++ b/dist/ExtUtils-ParseXS/t/pseudotypemap1
@@ -0,0 +1,5 @@
+  # pseudotypemap1:  comment with leading whitespace
+TYPEMAP  
+
+line_to_generate_insufficient_columns_warning
+unsigned long          T_UV