Fix searching for builtins in perlop POD
This commit is contained in:
parent
e499c58e11
commit
7a54aec8b4
File diff suppressed because it is too large
Load Diff
|
@ -0,0 +1,205 @@
|
|||
From aa7a2c99bff2a8d02d75f6b9f7155483cc94318c Mon Sep 17 00:00:00 2001
|
||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
||||
Date: Tue, 13 Aug 2019 16:49:21 +0200
|
||||
Subject: [PATCH 2/2] Search for X<> in the whole perlop document
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
perlop documents many operators before "Regexp Quote-Like Operators"
|
||||
(X<operator, regexp>) section. A change introduced with "Refactor
|
||||
search_perlop RT#86506" (d8b23dcb1a) commit started to ignore those
|
||||
operators. E.g. A search for '==' did not found anything. A search for
|
||||
'<>' returned too many text and broke POD syntax.
|
||||
|
||||
This patch searches for X<> index entries in all sections and
|
||||
considers =head keywords in addition to =item as section delimeters.
|
||||
|
||||
Because some X<> entries exists on more places, this patch implements
|
||||
this strategy: First =item section that contains the X<> entry is
|
||||
returned. If there is no =item sections, last =head section is
|
||||
returned. If the =item entry is empty (like for 'tr'), the the output
|
||||
continues up to and including a next non-empty =item. This strategy is
|
||||
implemented in one pass.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
lib/Pod/Perldoc.pm | 116 ++++++++++++++++++++++++++------------
|
||||
t/03_builtin_pod_output.t | 8 +++
|
||||
2 files changed, 89 insertions(+), 35 deletions(-)
|
||||
|
||||
diff --git a/lib/Pod/Perldoc.pm b/lib/Pod/Perldoc.pm
|
||||
index cd52aa2..b54cc23 100644
|
||||
--- a/lib/Pod/Perldoc.pm
|
||||
+++ b/lib/Pod/Perldoc.pm
|
||||
@@ -1153,6 +1153,20 @@ sub search_perlvar {
|
||||
|
||||
#..........................................................................
|
||||
|
||||
+# Check whether an item POD section contains any documentation text. The POD
|
||||
+# section is passed as refernce to list of lines.
|
||||
+# If there is no text, return true; otherwise false.
|
||||
+sub item_has_no_text {
|
||||
+ for (@{$_[0]}) {
|
||||
+ next if /^=over\s/;
|
||||
+ next if /^=item\s/;
|
||||
+ next if /^X</;
|
||||
+ next if /^\s*$/;
|
||||
+ return 0;
|
||||
+ }
|
||||
+ return 1;
|
||||
+}
|
||||
+
|
||||
sub search_perlop {
|
||||
my ($self,$found_things,$pod) = @_;
|
||||
|
||||
@@ -1166,60 +1180,92 @@ sub search_perlop {
|
||||
|
||||
my $thing = $self->opt_f;
|
||||
|
||||
- my $previous_line;
|
||||
+ my @previous_lines;
|
||||
+ my $stop_line;
|
||||
+ my $wrap_into_over;
|
||||
my $push = 0;
|
||||
- my $seen_item = 0;
|
||||
- my $skip = 1;
|
||||
+ my $pod_candidate = [];
|
||||
|
||||
while( my $line = <$fh> ) {
|
||||
$line =~ /^=encoding\s+(\S+)/ && $self->set_encoding($fh, $1);
|
||||
- # only start search after we hit the operator section
|
||||
- if ($line =~ m!^X<operator, regexp>!) {
|
||||
- $skip = 0;
|
||||
- }
|
||||
|
||||
- next if $skip;
|
||||
-
|
||||
- # strategy is to capture the previous line until we get a match on X<$thingy>
|
||||
- # if the current line contains X<$thingy>, then we push "=over", the previous line,
|
||||
- # the current line and keep pushing current line until we see a ^X<some-other-thing>,
|
||||
- # then we chop off final line from @$pod and add =back
|
||||
+ # A strategy is to capture the previous lines from =head or =item until we
|
||||
+ # get a match on X<$thing>. If the current line contains X<$thing>, then
|
||||
+ # we push "=over" (in case of =item), the previous lines, the current line
|
||||
+ # and keep pushing current line until we see a terminating POD keyworkd
|
||||
+ # (=head, =item, =over, corrsponding to the starting POD keyword). Then we
|
||||
+ # append =back (in case of =item).
|
||||
#
|
||||
- # At that point, Bob's your uncle.
|
||||
-
|
||||
- if ( $line =~ m!X<+\s*\Q$thing\E\s*>+!) {
|
||||
- if ( $previous_line ) {
|
||||
- push @$pod, "=over 8\n\n", $previous_line;
|
||||
- $previous_line = "";
|
||||
+ # If this was =item, we are done. If the =item was empty (like two
|
||||
+ # consequtive =item-s documented at once) we continue gathering other
|
||||
+ # =item-s until we get some content. Then we are done.
|
||||
+ #
|
||||
+ # If this was a =head, we stash the POD section and do another search in
|
||||
+ # hope we will found =item section. (=item sections tends to be more
|
||||
+ # focused on =X<$thing> than =head sections.) If did not found any =item
|
||||
+ # section, we will return the last found =head section.
|
||||
+
|
||||
+ if ( $line =~ m!X<+\s*\Q$thing\E\s*>+! ) {
|
||||
+ if ( @previous_lines ) {
|
||||
+ push @$pod_candidate, "=over 8\n\n" if $wrap_into_over;
|
||||
+ push @$pod_candidate, @previous_lines;
|
||||
+ @previous_lines = ();
|
||||
}
|
||||
- push @$pod, $line;
|
||||
+ push @$pod_candidate, $line;
|
||||
$push = 1;
|
||||
|
||||
}
|
||||
- elsif ( $push and $line =~ m!^=item\s*.*$! ) {
|
||||
- $seen_item = 1;
|
||||
- }
|
||||
- elsif ( $push and $seen_item and $line =~ m!^X<+\s*[ a-z,?-]+\s*>+!) {
|
||||
+ elsif ( $push and $line =~ m/$stop_line/ ) {
|
||||
$push = 0;
|
||||
- $seen_item = 0;
|
||||
- last;
|
||||
+
|
||||
+ # X<tr> exists twice in perlop. Prefer =item location over =head
|
||||
+ # location. We assume =item is more specific.
|
||||
+ if ($wrap_into_over) {
|
||||
+ # However, the X<tr> =item section is empty (except of bunch of
|
||||
+ # X<> kewords) and documented in the next =item section. Thus
|
||||
+ # continue until the so far gathered text looks empty.
|
||||
+ if ($line =~ /^=item\s/ && item_has_no_text($pod_candidate)) {
|
||||
+ $push = 1;
|
||||
+ push @$pod_candidate, $line;
|
||||
+ # and continue appending following =item section
|
||||
+ } else {
|
||||
+ # We have an =item with a content.
|
||||
+ push @$pod_candidate, "\n\n=back\n";
|
||||
+ # Replace pod with the candidate
|
||||
+ @$pod = @$pod_candidate;
|
||||
+ last;
|
||||
+ }
|
||||
+ } else {
|
||||
+ # Copy the candidate to pod
|
||||
+ push @$pod, @$pod_candidate;
|
||||
+ $pod_candidate = [];
|
||||
+ # And search for another occurance of the X<> reference with the
|
||||
+ # prospect it will be an =item.
|
||||
+ }
|
||||
}
|
||||
elsif ( $push ) {
|
||||
- push @$pod, $line;
|
||||
- }
|
||||
-
|
||||
- else {
|
||||
- $previous_line = $line;
|
||||
+ push @$pod_candidate, $line;
|
||||
+ }
|
||||
+
|
||||
+ if ( !$push ) {
|
||||
+ # Gather a smallest block starting with "=head" or "=item"
|
||||
+ if ($line =~ /^=head([1234])\s/) {
|
||||
+ $stop_line = join('', 1..$1);
|
||||
+ $stop_line = qr/^=head[$stop_line]\s/;
|
||||
+ $wrap_into_over = 0;
|
||||
+ @previous_lines = ();
|
||||
+ } elsif ($line =~ /^=item\s/) {
|
||||
+ $stop_line = qr/^=(?:item\s|back\b)/;
|
||||
+ $wrap_into_over = 1;
|
||||
+ @previous_lines = ();
|
||||
+ }
|
||||
+ push @previous_lines, $line;
|
||||
}
|
||||
|
||||
} #end while
|
||||
|
||||
# we overfilled by 1 line, so pop off final array element if we have any
|
||||
if ( scalar @$pod ) {
|
||||
- pop @$pod;
|
||||
-
|
||||
- # and add the =back
|
||||
- push @$pod, "\n\n=back\n";
|
||||
DEBUG > 8 and print "PERLOP POD --->" . (join "", @$pod) . "<---\n";
|
||||
}
|
||||
else {
|
||||
diff --git a/t/03_builtin_pod_output.t b/t/03_builtin_pod_output.t
|
||||
index 70f8549..d42a242 100644
|
||||
--- a/t/03_builtin_pod_output.t
|
||||
+++ b/t/03_builtin_pod_output.t
|
||||
@@ -24,6 +24,14 @@ my %builtins = (
|
||||
qr/\A\s+"tr\/\*SEARCHLIST\*\/\*REPLACEMENTLIST\*\/cdsr"\n/,
|
||||
qr/\n\s+eval "tr\/\$oldlist\/\$newlist\/, 1" or die \$\@;\n\n\z/
|
||||
],
|
||||
+ '==' => [ # CPAN RT#126015
|
||||
+ qr/\A\s+Equality Operators\n/,
|
||||
+ qr/\n\s+if \( fc\(\$x\) eq fc\(\$y\) \) \{ \.\.\. \}\n\n\z/
|
||||
+ ],
|
||||
+ '<>' => [ # CPAN RT#126015
|
||||
+ qr/\A\s+I\/O Operators\n/,
|
||||
+ qr/\n\s+for its regular truth value\.\n\n\z/
|
||||
+ ]
|
||||
);
|
||||
|
||||
plan tests => 5 * scalar keys %builtins;
|
||||
--
|
||||
2.21.0
|
||||
|
|
@ -8,13 +8,17 @@
|
|||
Name: perl-Pod-Perldoc
|
||||
# let's overwrite the module from perl.srpm
|
||||
Version: 3.28.01
|
||||
Release: 440%{?dist}
|
||||
Release: 441%{?dist}
|
||||
Summary: Look up Perl documentation in Pod format
|
||||
License: GPL+ or Artistic
|
||||
URL: https://metacpan.org/release/Pod-Perldoc
|
||||
Source0: https://cpan.metacpan.org/authors/id/M/MA/MALLEN/Pod-Perldoc-%{base_version}.tar.gz
|
||||
# Unbundled from perl 5.28.0-RC1
|
||||
Patch0: Pod-Perldoc-3.28-Upgrade-to-3.2801.patch
|
||||
# 1/2 Fix searching for builtins in perlop POD, bug #1739463, CPAN RT#126015
|
||||
Patch1: Pod-Perldoc-3.28-Add-a-test-for-a-truncated-perldoc-f-tr-output.patch
|
||||
# 1/2 Fix searching for builtins in perlop POD, bug #1739463, CPAN RT#126015
|
||||
Patch2: Pod-Perldoc-3.28-Search-for-X-in-the-whole-perlop-document.patch
|
||||
BuildArch: noarch
|
||||
BuildRequires: findutils
|
||||
BuildRequires: make
|
||||
|
@ -94,6 +98,8 @@ the perl library modules.
|
|||
%prep
|
||||
%setup -q -n Pod-Perldoc-%{base_version}
|
||||
%patch0 -p1
|
||||
%patch1 -p1
|
||||
%patch2 -p1
|
||||
|
||||
%build
|
||||
perl Makefile.PL INSTALLDIRS=vendor
|
||||
|
@ -115,6 +121,9 @@ make test
|
|||
%{_mandir}/man3/*
|
||||
|
||||
%changelog
|
||||
* Thu Aug 15 2019 Petr Pisar <ppisar@redhat.com> - 3.28.01-441
|
||||
- Fix searching for builtins in perlop POD (bug #1739463)
|
||||
|
||||
* Fri Jul 26 2019 Fedora Release Engineering <releng@fedoraproject.org> - 3.28.01-440
|
||||
- Rebuilt for https://fedoraproject.org/wiki/Fedora_31_Mass_Rebuild
|
||||
|
||||
|
|
Loading…
Reference in New Issue