From bb5e8eb43128d5ce9d69cb03886e752b19f7b175 Mon Sep 17 00:00:00 2001 From: "James E. Keenan" Date: Sun, 6 Feb 2011 12:07:15 +0100 Subject: [PATCH] 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). --- MANIFEST | 4 + .../lib/ExtUtils/ParseXS/Utilities.pm | 115 ++++++++++++--------- dist/ExtUtils-ParseXS/t/104-map_type.t | 67 ++++++++++++ dist/ExtUtils-ParseXS/t/105-valid_proto_string.t | 30 ++++++ dist/ExtUtils-ParseXS/t/106-process_typemaps.t | 68 ++++++++++++ dist/ExtUtils-ParseXS/t/pseudotypemap1 | 5 + 6 files changed, 241 insertions(+), 48 deletions(-) create mode 100644 dist/ExtUtils-ParseXS/t/104-map_type.t create mode 100644 dist/ExtUtils-ParseXS/t/105-valid_proto_string.t create mode 100644 dist/ExtUtils-ParseXS/t/106-process_typemaps.t create mode 100644 dist/ExtUtils-ParseXS/t/pseudotypemap1 diff --git a/MANIFEST b/MANIFEST index b835f72..f984a13 100644 --- 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 --- 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 diff --git a/dist/ExtUtils-ParseXS/t/104-map_type.t b/dist/ExtUtils-ParseXS/t/104-map_type.t new file mode 100644 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 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 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 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 -- 2.7.4