Make diagnostics.pm understand messages sharing descriptions

We currently have entries in perldiag like this:

=item Code point 0x%X is not Unicode, may not be portable

=item Code point 0x%X is not Unicode, no properties match it; all inverse properties do

(W utf8) You had a code point above the Unicode maximum of U+10FFFF.

...

diagnostics.pm needs to know that the description applies to the first
=item, as well as to the second.

diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm
index cd4e7b6..b346448 100644 (file)
--- a/lib/diagnostics.pm
+++ b/lib/diagnostics.pm
@@ -319,7 +319,9 @@ my %msg;
     print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG;
     local $/ = '';
     my $header;
+    my @headers;
     my $for_item;
+    my $seen_body;
     while (<POD_DIAG>) {
 
        sub _split_pod_link {
@@ -365,10 +367,22 @@ my %msg;
                }
                s/^/    /gm;
                $msg{$header} .= $_;
+               for my $h(@headers) { $msg{$h} .= $_ }
+               ++$seen_body;
                undef $for_item;        
            }
            next;
        } 
+
+       # If we have not come across the body of the description yet, then
+       # the previous header needs to share the same description.
+       if ($seen_body) {
+           @headers = ();
+       }
+       else {
+           push @headers, $header if defined $header;
+       }
+
        unless ( s/=item (.*?)\s*\z//) {
 
            if ( s/=head1\sDESCRIPTION//) {
@@ -428,6 +442,7 @@ my %msg;
            if $msg{$header};
 
        $msg{$header} = '';
+       $seen_body = 0;
     } 
 
 

diff --git a/lib/diagnostics.t b/lib/diagnostics.t
index 81896cd..06ab536 100644 (file)
--- a/lib/diagnostics.t
+++ b/lib/diagnostics.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = 'lib';
 }
 
-use Test::More tests => 5;
+use Test::More tests => 6;
 
 BEGIN { use_ok('diagnostics') }
 
@@ -36,3 +36,11 @@ $warning = '';
 warn
  'Lexing code attempted to stuff non-Latin-1 character into Latin-1 input';
 like $warning, qr/using lex_stuff_pvn_flags or similar/, 'L<foo|bar/baz>';
+
+# Multiple messages with the same description
+seek STDERR, 0,0;
+$warning = '';
+warn 'Code point 0x%X is not Unicode, may not be portable';
+like $warning, qr/W utf8/,
+   'Message sharing its description with the following message';
+