Implement mess

[perl5.git] / lib / diagnostics.t

diff --git a/lib/diagnostics.t b/lib/diagnostics.t
index d6b6c82..6521df2 100644 (file)
--- 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(28);
+    plan(31);
 }
 
 BEGIN {
@@ -51,6 +51,11 @@ $warning = '';
 warn 'Deep recursion on anonymous subroutine';
 like $warning, qr/W recursion/,
    'Message sharing its description with the following message';
+seek STDERR, 0,0;
+$warning = '';
+warn 'Deep recursion on subroutine "foo"';
+like $warning, qr/W recursion/,
+   'Message sharing its description with the preceding message';
 
 # Periods at end of entries in perldiag.pod get matched correctly
 seek STDERR, 0,0;
@@ -101,13 +106,13 @@ seek STDERR, 0,0;
 $warning = '';
 warn "Using just the first character returned by \\N{} in character class in regex; marked by <-- HERE in m/%s/";
 like $warning,
-    qr/A charnames handler may return a sequence/s,
+    qr/Named Unicode character escapes/s,
     'multi-line entries in perldiag.pod match';
 
 # ; at end of entry in perldiag.pod
 seek STDERR, 0,0;
 $warning = '';
-warn "Perl folding rules are not up-to-date for 0xA; please use the perlbug utility to report; in regex; marked by <-- HERE in m/\ <-- HERE q/";
+warn "Perl folding rules are not up-to-date for 0x0A; please use the perlbug utility to report; in regex; marked by <-- HERE in m/\ <-- HERE q/";
 like $warning,
     qr/You used a regular expression with case-insensitive matching/s,
     '; works at the end of entries in perldiag.pod';
@@ -139,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 /^=/;
@@ -169,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 = '';