diff options
| -rw-r--r-- | lib/diagnostics.pm | 15 | ||||
| -rw-r--r-- | lib/diagnostics.t | 10 |
2 files changed, 24 insertions, 1 deletions
diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index cd4e7b6151..b3464488d7 100644 --- 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 81896cda64..06ab5363d5 100644 --- 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'; + |