summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/diagnostics.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/diagnostics.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/diagnostics.pm31
1 files changed, 16 insertions, 15 deletions
diff --git a/Master/tlpkg/tlperl/lib/diagnostics.pm b/Master/tlpkg/tlperl/lib/diagnostics.pm
index 39bcb3d1dd0..6ccc3d02af1 100644
--- a/Master/tlpkg/tlperl/lib/diagnostics.pm
+++ b/Master/tlpkg/tlperl/lib/diagnostics.pm
@@ -186,7 +186,7 @@ use 5.009001;
use Carp;
$Carp::Internal{__PACKAGE__.""}++;
-our $VERSION = '1.28';
+our $VERSION = '1.31';
our $DEBUG;
our $VERBOSE;
our $PRETTY;
@@ -385,7 +385,7 @@ my %msg;
push @headers, $header if defined $header;
}
- unless ( s/=item (.*?)\s*\z//) {
+ unless ( s/=item (.*?)\s*\z//s) {
if ( s/=head1\sDESCRIPTION//) {
$msg{$header = 'DESCRIPTION'} = '';
@@ -400,19 +400,17 @@ my %msg;
if( $for_item ) { $header = $for_item; undef $for_item }
else {
$header = $1;
- while( $header =~ /[;,]\z/ ) {
- <POD_DIAG> =~ /^\s*(.*?)\s*\z/;
- $header .= ' '.$1;
- }
+
+ $header =~ s/\n/ /gs; # Allow multi-line headers
}
# strip formatting directives from =item line
$header =~ s/[A-Z]<(.*?)>/$1/g;
- # Since we strip "\.\n" when we search a warning, strip it here as well
- $header =~ s/\.?$//;
+ # Since we strip "(\.\s*)\n" when we search a warning, strip it here as well
+ $header =~ s/(\.\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 +423,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];
@@ -434,12 +432,15 @@ my %msg;
}
}
my $lhs = join( '', @toks );
+ $lhs =~ s/(\\\s)+/\\s+/g; # Replace lit space with multi-space match
$transfmt{$header}{pat} =
- " s{^$lhs}\n {\Q$header\E}s\n\t&& return 1;\n";
+ " s^\\s*$lhs\\s*\Q$header\Es\n\t&& return 1;\n";
$transfmt{$header}{len} = $conlen;
} else {
+ my $lhs = "\Q$header\E";
+ $lhs =~ s/(\\\s)+/\\s+/g; # Replace lit space with multi-space match
$transfmt{$header}{pat} =
- " m{^\Q$header\E} && return 1;\n";
+ " s^\\s*$lhs\\s*\Q$header\E\n\t && return 1;\n";
$transfmt{$header}{len} = length( $header );
}
@@ -589,7 +590,7 @@ sub splainthis {
local $\;
local $!;
### &finish_compilation unless %msg;
- s/\.?\n+$//;
+ s/(\.\s*)?\n+$//;
my $orig = $_;
# return unless defined;
@@ -610,7 +611,7 @@ sub splainthis {
$_ .= ' at ' . $secs[$i];
}
}
-
+
# remove parenthesis occurring at the end of some messages
s/^\((.*)\)$/$1/;