lib/locale.t: Add some debugging info

[perl5.git] / lib / diagnostics.t

diff --git a/lib/diagnostics.t b/lib/diagnostics.t
index 6eecdda..0328522 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(24);
+    plan(28);
 }
 
 BEGIN {
@@ -43,7 +43,7 @@ seek STDERR, 0,0;
 $warning = '';
 warn
  'Lexing code attempted to stuff non-Latin-1 character into Latin-1 input';
-like $warning, qr/using lex_stuff_pvn or similar/, 'L<foo|bar/baz>';
+like $warning, qr/lex_stuff_pvn or similar/, 'L<foo|bar/baz>';
 
 # Multiple messages with the same description
 seek STDERR, 0,0;
@@ -109,7 +109,7 @@ 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/";
 like $warning,
-    qr/regular expression folding rules/s,
+    qr/You used a regular expression with case-insensitive matching/s,
     '; works at the end of entries in perldiag.pod';
 
 # Differences in spaces in warnings (Why not be nice and accept them?)
@@ -128,6 +128,56 @@ like $warning,
     qr/The whole warning/s,
     'spaces in warnings with periods at the end are matched lightly';
 
+# Wrapped links
+seek STDERR, 0,0;
+$warning = '';
+warn "Argument \"%s\" treated as 0 in increment (++)";
+like $warning,
+    qr/Auto-increment.*Auto-decrement/s,
+    'multiline links are not truncated';
+
+{
+# Find last warning in perldiag.pod, and last items if any
+    my $lw;
+    my $inlast;
+    my $item;
+
+    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;
+        } elsif ($inlast) {
+            # Skip headings
+            next if /^=/;
+
+            # Strip specials
+            $_ =~ s/\w<(.*?)>/$1/g;
+
+            # And whitespace
+            $_ =~ s/(^\s+|\s+$)//g;
+
+            if ($_) {
+                $item = $_;
+
+                last;
+            }
+        }
+    }
+    close($f);
+
+    ok($item, "(sanity...) found an item to check with ($item)");
+    seek STDERR, 0,0;
+    $warning = '';
+    warn $lw;
+    ok($warning, '(sanity...) got a warning');
+    unlike $warning,
+        qr/\Q$item\E/,
+        "Junk after =back doesn't show up in last warning";
+}
 
 *STDERR = $old_stderr;