From: Steffen Mueller <smueller@cpan.org>
Date: Fri, 20 Jan 2012 07:22:01 +0000 (+0100)
Subject: Better typemap error reporting
X-Git-Tag: accepted/trunk/20130322.191538~1054
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=8f37bf0c13a4deaf0c8b516504e890f2ce0ada33;p=platform%2Fupstream%2Fperl.git

Better typemap error reporting

If we couldn't find a typemap for a given C type, this now gives a list
of available, mapped C types.
---

diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
index c914f16..07d5909 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
@@ -37,6 +37,7 @@ use ExtUtils::ParseXS::Utilities qw(
   death
   check_conditional_preprocessor_statements
   escape_file_for_line_directive
+  report_typemap_failure
 );
 
 our @ISA = qw(Exporter);
@@ -1117,7 +1118,7 @@ sub INPUT_handler {
 
     if ($self->{var_num}) {
       my $typemap = $self->{typemap}->get_typemap(ctype => $var_type);
-      $self->death("Could not find a typemap for C type '$var_type'")
+      $self->report_typemap_failure($self->{typemap}, $var_type, "death")
         if not $typemap and not $is_overridden_typemap;
       $self->{proto_arg}->[$self->{var_num}] = ($typemap && $typemap->proto) || "\$";
     }
@@ -1815,7 +1816,7 @@ sub generate_init {
   my $typemaps = $self->{typemap};
 
   $type = tidy_type($type);
-  $self->blurt("Error: '$type' not in typemap"), return
+  $self->report_typemap_failure($typemaps, $type), return
     unless $typemaps->get_typemap(ctype => $type);
 
   ($ntype = $type) =~ s/\s*\*/Ptr/g;
@@ -1841,7 +1842,7 @@ sub generate_init {
   # Note: This gruesome bit either needs heavy rethinking or documentation. I vote for the former. --Steffen
   if ($expr =~ /DO_ARRAY_ELEM/) {
     my $subtypemap  = $typemaps->get_typemap(ctype => $subtype);
-    $self->blurt("Error: C type '$subtype' not in typemap"), return
+    $self->report_typemap_failure($typemaps, $subtype), return
       if not $subtypemap;
     my $subinputmap = $typemaps->get_inputmap(xstype => $subtypemap->xstype);
     $self->blurt("Error: No INPUT definition for type '$subtype', typekind '" . $subtypemap->xstype . "' found"), return
@@ -1916,8 +1917,8 @@ sub generate_output {
     print "\tSvSETMAGIC($arg);\n" if $do_setmagic;
   }
   else {
-    my $typemap   = $typemaps->get_typemap(ctype => $type);
-    $self->blurt("Could not find a typemap for C type '$type'"), return
+    my $typemap = $typemaps->get_typemap(ctype => $type);
+    $self->report_typemap_failure($typemaps, $type), return
       if not $typemap;
     my $outputmap = $typemaps->get_outputmap(xstype => $typemap->xstype);
     $self->blurt("Error: No OUTPUT definition for type '$type', typekind '" . $typemap->xstype . "' found"), return
@@ -1929,8 +1930,8 @@ sub generate_output {
 
     my $expr = $outputmap->cleaned_code;
     if ($expr =~ /DO_ARRAY_ELEM/) {
-      my $subtypemap   = $typemaps->get_typemap(ctype => $subtype);
-      $self->blurt("Could not find a typemap for C type '$subtype'"), return
+      my $subtypemap = $typemaps->get_typemap(ctype => $subtype);
+      $self->report_typemap_failure($typemaps, $subtype), return
         if not $subtypemap;
       my $suboutputmap = $typemaps->get_outputmap(xstype => $subtypemap->xstype);
       $self->blurt("Error: No OUTPUT definition for type '$subtype', typekind '" . $subtypemap->xstype . "' found"), return
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
index feb17fb..6e3fb95 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm
@@ -29,6 +29,7 @@ our (@ISA, @EXPORT_OK);
   death
   check_conditional_preprocessor_statements
   escape_file_for_line_directive
+  report_typemap_failure
 );
 
 =head1 NAME
@@ -55,6 +56,7 @@ ExtUtils::ParseXS::Utilities - Subroutines used with ExtUtils::ParseXS
     death
     check_conditional_preprocessor_statements
     escape_file_for_line_directive
+    report_typemap_failure
   );
 
 =head1 SUBROUTINES
@@ -874,6 +876,48 @@ sub escape_file_for_line_directive {
   return $string;
 }
 
+=head2 C<report_typemap_failure>
+
+=over 4
+
+=item * Purpose
+
+Do error reporting for missing typemaps.
+
+=item * Arguments
+
+The C<ExtUtils::ParseXS> object.
+
+An C<ExtUtils::Typemaps> object.
+
+The string that represents the C type that was not found in the typemap.
+
+Optionally, the string C<death> or C<blurt> to choose
+whether the error is immediately fatal or not. Default: C<blurt>
+
+=item * Return Value
+
+Returns nothing. Depending on the arguments, this
+may call C<death> or C<blurt>, the former of which is
+fatal.
+
+=back
+
+=cut
+
+sub report_typemap_failure {
+  my ($self, $tm, $ctype, $error_method) = @_;
+  $error_method ||= 'blurt';
+
+  my @avail_ctypes = $tm->list_mapped_ctypes;
+
+  my $err = "Could not find a typemap for C type '$ctype'.\n"
+            . "The following C types are mapped by the current typemap:\n'"
+            . join("', '", @avail_ctypes) . "'\n";
+
+  $self->$error_method($err);
+  return();
+}
 
 1;
 
diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
index b895efd..b39884c 100644
--- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
+++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm
@@ -688,6 +688,18 @@ sub is_empty {
       && @{ $self->{output_section} } == 0;
 }
 
+=head2 list_mapped_ctypes
+
+Returns a list of the C types that are mappable by
+this typemap object.
+
+=cut
+
+sub list_mapped_ctypes {
+  my $self = shift;
+  return sort keys %{ $self->{typemap_lookup} };
+}
+
 =head2 _get_typemap_hash
 
 Returns a hash mapping the C types to the XS types: