Teach diagnostics.pm about %p

diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm
index 66a0718..1efbd67 100644 (file)
--- a/lib/diagnostics.pm
+++ b/lib/diagnostics.pm
@@ -412,7 +412,7 @@ my %msg;
        # Since we strip "\.\n" when we search a warning, strip it here as well
        $header =~ s/\.?$//;
 
-        my @toks = split( /(%l?[dxX]|%u|%c|%(?:\.\d+)?[fs])/, $header );
+        my @toks = split( /(%l?[dxX]|%[ucp]|%(?:\.\d+)?[fs])/, $header );
        if (@toks > 1) {
             my $conlen = 0;
             for my $i (0..$#toks){
@@ -425,8 +425,8 @@ my %msg;
                         $toks[$i] = $i == $#toks ? '.*' : '.*?';
                     } elsif( $toks[$i] =~ '%.(\d+)s' ){
                         $toks[$i] = ".{$1}";
-                    } elsif( $toks[$i] =~ '^%l*([xX])$' ){
-                        $toks[$i] = $1 eq 'x' ? '[\da-f]+' : '[\dA-F]+';
+                    } elsif( $toks[$i] =~ '^%l*([pxX])$' ){
+                        $toks[$i] = $1 eq 'X' ? '[\dA-F]+' : '[\da-f]+';
                     }
                 } elsif( length( $toks[$i] ) ){
                     $toks[$i] = quotemeta $toks[$i];

diff --git a/lib/diagnostics.t b/lib/diagnostics.t
index 48f265f..035df76 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(18);
+    plan(19);
 }
 
 BEGIN {
@@ -70,6 +70,12 @@ $warning = '';
 warn "Unicode surrogate U+C0FFEE is illegal in UTF-8";
 like $warning, qr/You had a UTF-16 surrogate/, '%X';
 
+# Test for %p
+seek STDERR, 0,0;
+$warning = '';
+warn "Slab leaked from cv fadedc0ffee";
+like $warning, qr/bookkeeping of op trees/, '%p';
+
 # Strip S<>
 seek STDERR, 0,0;
 $warning = '';