This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
RT-119817 - Treat =back as the end of a warning description.
authorMatthew Horsfall (alh) <wolfsage@gmail.com>
Tue, 17 Sep 2013 12:49:35 +0000 (08:49 -0400)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 17 Sep 2013 19:36:04 +0000 (12:36 -0700)
This keeps any trailing data in the file from showing up as part
of the last warning's description.

lib/diagnostics.pm
lib/diagnostics.t

index 33c25d4..1c210c4 100644 (file)
@@ -186,7 +186,7 @@ use 5.009001;
 use Carp;
 $Carp::Internal{__PACKAGE__.""}++;
 
-our $VERSION = '1.32';
+our $VERSION = '1.33';
 our $DEBUG;
 our $VERBOSE;
 our $PRETTY;
@@ -393,7 +393,13 @@ 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;
+           }
            next;
        }
 
index a7e31e1..0328522 100644 (file)
@@ -4,7 +4,7 @@ BEGIN {
     chdir '..' if -d '../pod' && -d '../t';
     @INC = 'lib';
     require './t/test.pl';
-    plan(25);
+    plan(28);
 }
 
 BEGIN {
@@ -136,6 +136,48 @@ 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;