This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
podcheck.t: Skip perl5200delta
[perl5.git] / t / porting / podcheck.t
index 4cea599..8fc674c 100644 (file)
@@ -33,7 +33,8 @@ podcheck.t - Look for possible problems in the Perl pods
 
  cd t
  ./perl -I../lib porting/podcheck.t [--show_all] [--cpan] [--deltas]
-                                                  [--counts] [ FILE ...]
+                                    [--counts] [--pedantic] [FILE ...]
+
  ./perl -I../lib porting/podcheck.t --add_link MODULE ...
 
  ./perl -I../lib porting/podcheck.t --regen
@@ -49,7 +50,7 @@ fail a pod only if the number of such problems differs from that given in the
 database.  It also suppresses the C<(section) deprecated> message from
 Pod::Checker, since specifying the man page section number is quite proper to do.
 
-The additional checks it makes are:
+The additional checks it always makes are:
 
 =over
 
@@ -66,7 +67,7 @@ The way that the C<LE<lt>E<gt>> pod command works (for links outside the pod)
 is to actually create a link to C<search.cpan.org> with an embedded query for
 the desired pod or man page.  That means that links outside the distribution
 are valid.  podcheck.t doesn't verify the validity of such links, but instead
-keeps a data base of those known to be valid.  This means that if a link to a
+keeps a database of those known to be valid.  This means that if a link to a
 target not on the list is created, the target needs to be added to the data
 base.  This is accomplished via the L<--add_link|/--add_link MODULE ...>
 option to podcheck.t, described below.
@@ -77,6 +78,24 @@ If a link is broken, but there is an existing internal target of the same
 name, it is likely that the internal target was meant, and the C<"/"> is
 missing from the C<LE<lt>E<gt>> pod command.
 
+=item Missing or duplicate NAME or missing NAME short description
+
+A pod can't be linked to unless it has a unique name.
+And a NAME should have a dash and short description after it.
+
+=item =encoding statement issues
+
+This indicates if an C<=encoding> statement should be present, or moved to the
+front of the pod.
+
+=back
+
+If the C<PERL_POD_PEDANTIC> environment variable is set or the C<--pedantic>
+command line argument is provided then a few more checks are made.
+The pedantic checks are:
+
+=over
+
 =item Verbatim paragraphs that wrap in an 80 (including 1 spare) column window
 
 It's annoying to have lines wrap when displaying pod documentation in a
@@ -89,16 +108,6 @@ order to fit.
 Often, the easiest thing to do to gain space for these is to lower the indent
 to just one space.
 
-=item Missing or duplicate NAME or missing NAME short description
-
-A pod can't be linked to unless it has a unique name.
-And a NAME should have a dash and short description after it.
-
-=item =encoding statement issues
-
-This indicates if an C<=encoding> statement should be present, or moved to the
-front of the pod.
-
 =item Items that perhaps should be links
 
 There are mentions of apparent files in the pods that perhaps should be links
@@ -140,7 +149,7 @@ cause the corresponding error to always be suppressed no matter how many there
 actually are.
 
 Another problem is that there is currently no check that modules listed as
-valid in the data base
+valid in the database
 actually are.  Thus any errors introduced there will remain there.
 
 =head2 Specially handled pods
@@ -189,24 +198,24 @@ exist, and to silence any messages that links to them are broken.
 
 podcheck.t checks that links within the Perl core distribution are valid, but
 it doesn't check links to man pages or external modules.  When it finds
-a broken link, it checks its data base of external modules and man pages,
+a broken link, it checks its database of external modules and man pages,
 and only if not found there does it raise a message.  This option just adds
 the list of modules and man page references that follow it on the command line
-to that data base.
+to that database.
 
 For example,
 
     cd t
     ./perl -I../lib porting/podcheck.t --add_link Unicode::Casing
 
-causes the external module "Unicode::Casing" to be added to the data base, so
+causes the external module "Unicode::Casing" to be added to the database, so
 C<LE<lt>Unicode::CasingE<gt>> will be considered valid.
 
 =item --regen
 
-Regenerate the data base used by podcheck.t to include all the existing
+Regenerate the database used by podcheck.t to include all the existing
 potential problems.  Future runs of the program will not then flag any of
-these.
+these.  Setting this option also sets C<--pedantic>.
 
 =item --cpan
 
@@ -233,7 +242,14 @@ any particular FILES to operate on automatically selects this option.
 =item --counts
 
 Instead of testing, this just dumps the counts of the occurrences of the
-various types of potential problems in the data base.
+various types of potential problems in the database.
+
+=item --pedantic
+
+There are three potential problems that are not checked for by default.
+This options enables them. The environment variable C<PERL_POD_PEDANTIC>
+can be set to 1 to enable this option also.
+This option is set when C<--regen> is used.
 
 =back
 
@@ -334,17 +350,18 @@ my $INDENT = 7;             # default nroff indent
 
 # Our warning messages.  Better not have [('"] in them, as those are used as
 # delimiters for variable parts of the messages by poderror.
-my $line_length = "Verbatim line length including indents exceeds $MAX_LINE_LENGTH by";
 my $broken_link = "Apparent broken link";
 my $broken_internal_link = "Apparent internal link is missing its forward slash";
-my $see_not_linked = "? Should you be using L<...> instead of";
-my $C_with_slash = "? Should you be using F<...> or maybe L<...> instead of";
 my $multiple_targets = "There is more than one target";
 my $duplicate_name = "Pod NAME already used";
 my $need_encoding = "Should have =encoding statement because have non-ASCII";
 my $encoding_first = "=encoding must be first command (if present)";
 my $no_name = "There is no NAME";
 my $missing_name_description = "The NAME should have a dash and short description after it";
+# the pedantic warnings messages
+my $line_length = "Verbatim line length including indents exceeds $MAX_LINE_LENGTH by";
+my $C_not_linked = "? Should you be using L<...> instead of";
+my $C_with_slash = "? Should you be using F<...> or maybe L<...> instead of";
 
 # objects, tests, etc can't be pods, so don't look for them. Also skip
 # files output by the patch program.  Could also ignore most of .gitignore
@@ -359,6 +376,9 @@ my $dl_ext  = $Config{'dlext'};   $dl_ext  =~ tr/.//d;
 my %excluded_files = (
                         canonicalize("lib/unicore/mktables") => 1,
                         canonicalize("Porting/make-rmg-checklist") => 1,
+                        # this one is a POD, but unfinished, so skip
+                        # it for now
+                        canonicalize("Porting/perl5200delta.pod") => 1,
                         canonicalize("Porting/perldelta_template.pod") => 1,
                         canonicalize("regen/feature.pl") => 1,
                         canonicalize("autodoc.pl") => 1,
@@ -440,6 +460,7 @@ my @suppressed_messages = (
     "unescaped <>",
     "Entity number out of range",   # Checker outputs this for anything above
                                     # 255, but in fact all Unicode is valid
+    "No items in =over",            # ie a blockquote
 );
 
 sub suppressed {
@@ -516,6 +537,7 @@ my $show_counts = 0;
 my $regen = 0;
 my $add_link = 0;
 my $show_all = 0;
+my $pedantic = 0;
 
 my $do_upstream_cpan = 0; # Assume that are to skip anything in /cpan
 my $do_deltas = 0;        # And stable perldeltas
@@ -526,6 +548,7 @@ while (@ARGV && substr($ARGV[0], 0, 1) eq '-') {
     $arg =~ s/^--/-/; # Treat '--' the same as a single '-'
     if ($arg eq '-regen') {
         $regen = 1;
+        $pedantic = 1;
     }
     elsif ($arg eq '-add_link') {
         $add_link = 1;
@@ -542,22 +565,27 @@ while (@ARGV && substr($ARGV[0], 0, 1) eq '-') {
     elsif ($arg eq '-counts') {
         $show_counts = 1;
     }
+    elsif ($arg eq '-pedantic') {
+        $pedantic = 1;
+    }
     else {
         die <<EOF;
 Unknown option '$arg'
 
 Usage: $0 [ --regen | --cpan | --show_all | FILE ... | --add_link MODULE ... ]\n"
-    --add_link -> Add the MODULE and man page references to the data base
+    --add_link -> Add the MODULE and man page references to the database
     --regen    -> Regenerate the data file for $0
     --cpan     -> Include files in the cpan subdirectory.
     --deltas   -> Include stable perldeltas
     --show_all -> Show all known potential problems
     --counts   -> Don't test, but give summary counts of the currently
                   existing database
+    --pedantic -> Check for overly long lines in verbatim blocks
 EOF
     }
 }
 
+$pedantic = 1 if exists $ENV{PERL_POD_PEDANTIC} and $ENV{PERL_POD_PEDANTIC};
 my @files = @ARGV;
 
 my $cpan_or_deltas = $do_upstream_cpan || $do_deltas;
@@ -567,14 +595,19 @@ if (($regen + $show_all + $show_counts + $add_link + $cpan_or_deltas ) > 1) {
 
 my $has_input_files = @files;
 
-if ($has_input_files
-    && ($regen || $show_counts || $do_upstream_cpan || $do_deltas))
-{
-    croak "--regen, --counts, --deltas, and --cpan can't be used since using specific files";
-}
 
-if ($add_link && ! $has_input_files) {
-    croak "--add_link requires at least one module or man page reference";
+if ($add_link) {
+    if (! $has_input_files) {
+        croak "--add_link requires at least one module or man page reference";
+    }
+}
+elsif ($has_input_files) {
+    if ($regen || $show_counts || $do_upstream_cpan || $do_deltas) {
+        croak "--regen, --counts, --deltas, and --cpan can't be used since using specific files";
+    }
+    foreach my $file (@files) {
+        croak "Can't read file '$file'" if ! -r $file;
+    }
 }
 
 our %problems;  # potential problems found in this run
@@ -778,14 +811,18 @@ package My::Pod::Checker {      # Extend Pod::Checker
             }
             $lines[$i] =~ s/\s+$//;
             my $indent = $self->get_current_indent;
-            my $exceeds = length(Text::Tabs::expand($lines[$i]))
-                          + $indent - $MAX_LINE_LENGTH;
-            next unless $exceeds > 0;
-            my ($file, $line) = $pod_para->file_line;
-            $self->poderror({ -line => $line + $i, -file => $file,
-                -msg => $line_length,
-                parameter => "+$exceeds (including " . ($indent - $INDENT) . " from =over's)",
-            });
+
+            if ($pedantic) { # TODO: this check should be moved higher
+                                 # to avoid more unnecessary work
+                my $exceeds = length(Text::Tabs::expand($lines[$i]))
+                    + $indent - $MAX_LINE_LENGTH;
+                next unless $exceeds > 0;
+                my ($file, $line) = $pod_para->file_line;
+                $self->poderror({ -line => $line + $i, -file => $file,
+                    -msg => $line_length,
+                    parameter => "+$exceeds (including " . ($indent - $INDENT) . " from =over's)",
+                });
+            }
         }
     }
 
@@ -883,19 +920,21 @@ package My::Pod::Checker {      # Extend Pod::Checker
                             && $interior !~ /\/.+\//)
                     )
                 ) {
+                    # TODO: move the checking of $pedantic higher up
                     $self->poderror({ -line => $line, -file => $file,
-                        -msg => $see_not_linked,
+                        -msg => $C_not_linked,
                         parameter => $construct
-                    });
+                    }) if $pedantic;
                 }
             }
         }
         while ($paragraph =~ m/$C_path_re/g) {
             my $construct = $1;
+            # TODO: move the checking of $pedantic higher up
             $self->poderror({ -line => $line, -file => $file,
                 -msg => $C_with_slash,
                 parameter => $construct
-            });
+            }) if $pedantic;
         }
         return;
     }
@@ -1116,7 +1155,7 @@ END
 my @existing_issues;
 
 
-while (<$data_fh>) {    # Read the data base
+while (<$data_fh>) {    # Read the database
     chomp;
     next if /^\s*(?:#|$)/;  # Skip comment and empty lines
     if (/\t/) {
@@ -1584,6 +1623,8 @@ foreach my $filename (@files) {
                      && $prior_filename =~ /^cpan/)
             {
                 $checker->set_skip("CPAN is upstream for $filename");
+            } elsif ( $filename =~ /^utils/ or $prior_filename =~ /^utils/ ) {
+                $checker->set_skip("$filename copy is in utils/");
             } else { # Here have two pods with identical names that differ
                 $prior_checker->poderror(
                         { -msg => $duplicate_name,
@@ -1788,6 +1829,7 @@ foreach my $filename (@files) {
 
         skip($skip, 1) if $skip;
         my @diagnostics;
+        my $thankful_diagnostics = 0;
         my $indent = '  ';
 
         my $total_known = 0;
@@ -1804,9 +1846,10 @@ foreach my $filename (@files) {
                 # subtract back this number we previously added in.
                 $total_known -= $problem_count;
 
-                $diagnostic .= $indent . $message;
+                $diagnostic .= $indent . qq{"$message"};
                 if ($problem_count > 2) {
-                    $diagnostic .= "  ($problem_count occurrences)";
+                    $diagnostic .= "  ($problem_count occurrences,"
+                       . " expected $known_problems{$canonical}{$message})";
                 }
                 foreach my $problem (@{$problems{$filename}{$message}}) {
                     $diagnostic .= " " if $problem_count == 1;
@@ -1819,6 +1862,7 @@ foreach my $filename (@files) {
                 $files_with_unknown_issues{$filename} = 1;
             } elsif ($problem_count < $known_problems{$canonical}{$message}) {
                $diagnostic = output_thanks($filename, $known_problems{$canonical}{$message}, $problem_count, $message);
+               $thankful_diagnostics++;
             }
             push @diagnostics, $diagnostic if $diagnostic;
         }
@@ -1830,14 +1874,24 @@ foreach my $filename (@files) {
             next if $problems{$filename}{$message};
             next if ! $known_problems{$canonical}{$message};
             next if $known_problems{$canonical}{$message} < 0; # Preserve negs
+
+            next if !$pedantic and $message =~ 
+                /^(?:\Q$line_length\E|\Q$C_not_linked\E|\Q$C_with_slash\E)/;
+
             my $diagnostic = output_thanks($filename, $known_problems{$canonical}{$message}, 0, $message);
             push @diagnostics, $diagnostic if $diagnostic;
+            $thankful_diagnostics++ if $diagnostic;
         }
 
         my $output = "POD of $filename";
         $output .= ", excluding $total_known not shown known potential problems"
                                                                 if $total_known;
-        ok(@diagnostics == 0, $output);
+        if (@diagnostics && @diagnostics == $thankful_diagnostics) {
+            # Output fixed issues as passing to-do tests, so they do not
+            # cause failures, but t/harness still flags them.
+            $output .= " # TODO"
+        }
+        ok(@diagnostics == $thankful_diagnostics, $output);
         if (@diagnostics) {
             note(join "", @diagnostics,
             "See end of this test output for your options on silencing this");
@@ -1847,7 +1901,9 @@ foreach my $filename (@files) {
     }
 }
 
-if (! ok (keys %known_problems == 0, "The known problems data base includes no references to non-existent files")) {
+if (! $regen
+    && ! ok (keys %known_problems == 0, "The known problems database includes no references to non-existent files"))
+{
     note("The following files were not found: "
          . join ", ", keys %known_problems);
     note("They will automatically be removed from the db the next time");