diff options
author | Karl Williamson <khw@cpan.org> | 2016-06-15 12:51:39 -0600 |
---|---|---|
committer | Karl Williamson <khw@cpan.org> | 2016-06-17 12:45:20 -0600 |
commit | a1399808f7d0c25a44b5677fd6cafda57e658955 (patch) | |
tree | 4521d4a1b21519d8ef76ea99914eb6014a93017c /lib | |
parent | 6405d2efd52180a82bb921486ffeb4adf0167ecd (diff) | |
download | perl-a1399808f7d0c25a44b5677fd6cafda57e658955.tar.gz |
diagnostics.pm; Enhance to accept nested lists
Prior to this patch, this module assumed every =item was for a
diagnostic. Now it keeps track, and so a given diagnostic can have a
list within it.
Diffstat (limited to 'lib')
-rw-r--r-- | lib/diagnostics.pm | 21 | ||||
-rw-r--r-- | lib/diagnostics.t | 25 |
2 files changed, 34 insertions, 12 deletions
diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index 40c6748c57..731b1a00a7 100644 --- a/lib/diagnostics.pm +++ b/lib/diagnostics.pm @@ -186,7 +186,7 @@ use 5.009001; use Carp; $Carp::Internal{__PACKAGE__.""}++; -our $VERSION = '1.34'; +our $VERSION = '1.35'; our $DEBUG; our $VERBOSE; our $PRETTY; @@ -310,6 +310,7 @@ sub transmo { EOFUNC my %msg; +my $over_level = 0; # We look only at =item lines at the first =over level { print STDERR "FINISHING COMPILATION for $_\n" if $DEBUG; local $/ = ''; @@ -386,7 +387,7 @@ my %msg; push @headers, $header if defined $header; } - unless ( s/=item (.*?)\s*\z//s) { + if ( ! s/=item (.*?)\s*\z//s || $over_level != 1) { if ( s/=head1\sDESCRIPTION//) { $msg{$header = 'DESCRIPTION'} = ''; @@ -395,11 +396,17 @@ my %msg; elsif( s/^=for\s+diagnostics\s*\n(.*?)\s*\z// ) { $for_item = $1; } - elsif( /^=back/ ) { # Stop processing body here - undef $header; - undef $for_item; - $seen_body = 0; - next; + elsif( /^=over\b/ ) { + $over_level++; + } + elsif( /^=back\b/ ) { # Stop processing body here + $over_level--; + if ($over_level == 0) { + undef $header; + undef $for_item; + $seen_body = 0; + next; + } } next; } diff --git a/lib/diagnostics.t b/lib/diagnostics.t index 0b35d16c06..6521df2d5c 100644 --- a/lib/diagnostics.t +++ b/lib/diagnostics.t @@ -4,7 +4,7 @@ BEGIN { chdir '..' if -d '../pod' && -d '../t'; @INC = 'lib'; require './t/test.pl'; - plan(29); + plan(31); } BEGIN { @@ -144,17 +144,30 @@ like $warning, { # Find last warning in perldiag.pod, and last items if any my $lw; + my $over_level = 0; my $inlast; my $item; + my $items_not_in_overs = 0; open(my $f, '<', "pod/perldiag.pod") or die "failed to open pod/perldiag.pod for reading: $!"; while (<$f>) { - if ( /^=item\s+(.*)/) { - $lw = $1; - } elsif (/^=back/) { - $inlast = 1; + + # We only look for entries (=item lines) in the first level of =overs + + if ( /^=over\b/) { + $over_level++; + } elsif ( /^=item\s+(.*)/) { + if ($over_level < 1) { + $items_not_in_overs++; + } + elsif ($over_level == 1) { + $lw = $1; + } + } elsif (/^=back\b/) { + $inlast = 1 if $over_level == 1; + $over_level--; } elsif ($inlast) { # Skip headings next if /^=/; @@ -174,6 +187,8 @@ like $warning, } close($f); + is($over_level, 0, "(sanity...) =over balanced with =back (off by $over_level)"); + is($items_not_in_overs, 0, "(sanity...) all =item lines are within =over..=back blocks"); ok($item, "(sanity...) found an item to check with ($item)"); seek STDERR, 0,0; $warning = ''; |