#!/usr/bin/perl -w
+package main;
+
BEGIN {
chdir 't';
- unshift @INC, "../lib";
+ @INC = "../lib";
+ # Do not require test.pl, this file has its own framework.
}
use strict;
use Text::Tabs;
BEGIN {
+ if ( $Config{usecrosscompile} ) {
+ print "1..0 # Not all files are available during cross-compilation\n";
+ exit 0;
+ }
+ if ($^O eq 'dec_osf') {
+ print "1..0 # $^O cannot handle this test\n";
+ exit(0);
+ }
+ if ( $ENV{'PERL_BUILD_PACKAGING'} ) {
+ print "1..0 # This distro may have modified some files in cpan/. Skipping validation. \n";
+ exit 0;
+ }
require '../regen/regen_lib.pl';
}
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
(specified below). It does additional checking beyond that done by
Pod::Checker, and keeps a database of known potential problems, and will
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.
+database.
-The additional checks it makes are:
+The additional checks it always makes are:
=over
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.
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 Occurrences of the Unicode replacement character
+
+L<Pod::Simple> replaces bytes that aren't valid according to the document's
+encoding (declared or auto-detected) with C<\N{REPLACEMENT CHARACTER}>.
+
+=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
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
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
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
=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
# 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";
+my $replacement_character = "Unicode replacement character found";
+# 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
canonicalize("Porting/make-rmg-checklist") => 1,
canonicalize("Porting/perldelta_template.pod") => 1,
canonicalize("regen/feature.pl") => 1,
+ canonicalize("regen/warnings.pl") => 1,
canonicalize("autodoc.pl") => 1,
canonicalize("configpm") => 1,
canonicalize("miniperl") => 1,
| $lib_ext # object libraries
| $lib_so # shared libraries
| $dl_ext # dynamic libraries
+ | gif # GIF images (example files from CGI.pm)
+ | eg # examples from libnet
+ | core .*
)
$
) | ~$ | \ \(Autosaved\)\.txt$ # Other editor droppings
| ^cxx\$demangler_db\.$ # VMS name mangler database
| ^typemap\.?$ # typemap files
| ^(?i:Makefile\.PL)$
+ | ^core (?: $ | \. .* )
/x;
+# Matches something that looks like a file name, but is enclosed in C<...>
+my $C_path_re = qr{ ^
+ # exclude various things that have slashes
+ # in them but aren't paths
+ (?!
+ (?: (?: s | qr | m | tr | y ) / ) # regexes
+ | \d+/\d+ \b # probable fractions
+ | (?: [LF] < )+
+ | OS/2 \b
+ | Perl/Tk \b
+ | origin/blead \b
+ | origin/maint \b
+
+ )
+ /? # Optional initial slash
+ \w+ # First component of path, doesn't begin with
+ # a minus
+ (?: / [-\w]+ )+ # Subsequent path components
+ (?: \. \w+ )? # Optional trailing dot and suffix
+ >* # Any enclosed L< F< have matching closing >
+ $
+ }x;
+
# '.PL' files should be excluded, as they aren't final pods, but often contain
# material used in generating pods, and so can look like a pod. We can't use
-# the regexp above because case sensisitivity is important for these, as some
+# the regexp above because case sensitivity is important for these, as some
# '.pl' files should be examined for pods. Instead look through the MANIFEST
# for .PL files and get their full path names, so we can exclude each such
# file explicitly. This works because other porting tests prohibit having two
# Pod::Checker messages to suppress
my @suppressed_messages = (
- "(section) in", # Checker is wrong to flag this
- "multiple occurrence of link target", # We catch independently the ones
- # that are real problems.
- "unescaped <>",
- "Entity number out of range", # Checker outputs this for anything above
- # 255, but in fact all Unicode is valid
+ # We catch independently the ones that are real problems.
+ qr/multiple occurrences \(\d+\) of link target/,
+
+ "unescaped <>", # Not every '<' or '>' need be escaped
+ qr/No items in =over/, # i.e., a blockquote, which we consider legal
);
sub suppressed {
# Returns bool as to if input message is one that is to be suppressed
my $message = shift;
- return grep { $message =~ /^\Q$_/i } @suppressed_messages;
+
+ return grep { $message =~ /^$_/i } @suppressed_messages;
}
{ # Closure to contain a simple subset of test.pl. This is to get rid of the
sub plan {
my %plan = @_;
- $planned = $plan{tests};
+ $planned = $plan{tests} + 1; # +1 for final test that files haven't
+ # been removed
print "1..$planned\n";
return;
}
$current_test++;
print "not " unless $success;
print "ok $current_test - $message\n";
- return;
+ return $success;
}
sub skip {
last SKIP;
}
- sub note {
- my $message = shift;
+ sub _note {
+ my ($andle, $message) = @_;
chomp $message;
- print $message =~ s/^/# /mgr;
- print "\n";
+ print $andle $message =~ s/^/# /mgr;
+ print $andle "\n";
return;
}
+ sub note { unshift @_, \*STDOUT; goto &_note }
+
+ sub diag { unshift @_, \*STDERR; goto &_note }
+
END {
if ($planned && $planned != $current_test) {
print STDERR
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
$arg =~ s/^--/-/; # Treat '--' the same as a single '-'
if ($arg eq '-regen') {
$regen = 1;
+ $pedantic = 1;
}
elsif ($arg eq '-add_link') {
$add_link = 1;
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;
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
# Uses inside out hash to protect from typos
# For new fields, remember to add to destructor DESTROY()
- my %indents; # Stack of indents from =over's in effect for
- # current line
+ my %CFL_text; # The text comprising the current C<>, F<>, or L<>
+ my %C_text; # If defined, are in a C<> section, and includes
+ # the accumulated text from that
my %current_indent; # Current line's indent
my %filename; # The pod is store in this file
- my %skip; # is SKIP set for this pod
+ my %in_CFL; # count of stacked C<>, F<>, L<> directives
+ my %indents; # Stack of indents from =over's in effect for
+ # current line
+ my %in_for; # true if in a =for or =begin
my %in_NAME; # true if within NAME section
my %in_begin; # true if within =begin section
+ my %in_X; # true if in a X<>
my %linkable_item; # Bool: if the latest =item is linkable. It isn't
# for bullet and number lists
my %linkable_nodes; # Pod::Checker adds all =items to its node list,
- # but not all =items are linkable to
- my %seen_encoding_cmd; # true if have =encoding earlier
+ # but not all =items are linkable-to
+ my %running_CFL_text; # The current text that is being accumulated until
+ # an end_FOO is found, and this includes any C<>,
+ # F<>, or L<> directives.
+ my %running_simple_text; # The currentt text that is being accumulated
+ # until an end_FOO is found, and all directives
+ # have been expanded into plain text
my %command_count; # Number of commands seen
my %seen_pod_cmd; # true if have =pod earlier
- my %warned_encoding; # true if already have warned about =encoding
- # problems
+ my %skip; # is SKIP set for this pod
+ my %start_line; # the first input line number in the the thing
+ # currently being worked on
sub DESTROY {
my $addr = Scalar::Util::refaddr $_[0];
+ delete $CFL_text{$addr};
+ delete $C_text{$addr};
delete $command_count{$addr};
delete $current_indent{$addr};
delete $filename{$addr};
delete $in_begin{$addr};
+ delete $in_CFL{$addr};
delete $indents{$addr};
+ delete $in_for{$addr};
delete $in_NAME{$addr};
+ delete $in_X{$addr};
delete $linkable_item{$addr};
delete $linkable_nodes{$addr};
- delete $seen_encoding_cmd{$addr};
+ delete $running_CFL_text{$addr};
+ delete $running_simple_text{$addr};
delete $seen_pod_cmd{$addr};
delete $skip{$addr};
- delete $warned_encoding{$addr};
+ delete $start_line{$addr};
return;
}
$current_indent{$addr} = 0;
$filename{$addr} = $filename;
$in_begin{$addr} = 0;
+ $in_X{$addr} = 0;
+ $in_CFL{$addr} = 0;
$in_NAME{$addr} = 0;
$linkable_item{$addr} = 0;
- $seen_encoding_cmd{$addr} = 0;
$seen_pod_cmd{$addr} = 0;
- $warned_encoding{$addr} = 0;
return $self;
}
#push @{$problems{$self->get_filename}{$message}}, $opts;
}
- sub check_encoding { # Does it need an =encoding statement?
- my ($self, $paragraph, $line_num, $pod_para) = @_;
+ # In the next subroutines, we keep track of the text of the current
+ # innermost thing, like F<fooC<bar>baz>. The things we care about raising
+ # messages about in this program all come from a single sequence of
+ # characters uninterrupted by other pod commands. Therefore we don't have
+ # to worry about recursion, and we can just set the string we care about
+ # to empty on entrance to each command.
+
+ sub handle_text {
+ # This is called by the parent class to deal with any straight text.
+ # We mostly just append this to the running current value which will
+ # be dealt with upon the end of the current construct, like a
+ # paragraph. But certain things don't contribute to checking the pod
+ # and are ignored. We also have set flags to indicate this text is
+ # going towards constructing certain constructs, and handle those
+ # specially.
- # Do nothing if there is an =encoding in the file, or if the line
- # doesn't require an =encoding, or have already warned.
+ my $self = shift;
my $addr = Scalar::Util::refaddr $self;
- return if $seen_encoding_cmd{$addr}
- || $warned_encoding{$addr}
- || $paragraph !~ /\P{ASCII}/;
-
- $warned_encoding{$addr} = 1;
- my ($file, $line) = $pod_para->file_line;
- $self->poderror({ -line => $line, -file => $file,
- -msg => $need_encoding
- });
- return;
- }
- sub verbatim {
- my ($self, $paragraph, $line_num, $pod_para) = @_;
- $self->check_encoding($paragraph, $line_num, $pod_para);
+ my $return = $self->SUPER::handle_text(@_);
- $self->SUPER::verbatim($paragraph, $line_num, $pod_para);
+ if ($in_X{$addr} || $in_for{$addr}) { # ignore
+ return $return;
+ }
- my $addr = Scalar::Util::refaddr $self;
+ my $text = join "\n", @_;
+ $running_simple_text{$addr} .= $text;
- # Pick up the name, since the parent class doesn't in verbatim
- # NAMEs; so treat as non-verbatim. The parent class only allows one
- # paragraph in a NAME section, so if there is an extra blank line, it
- # will trigger a message, but such a blank line is harmless, so skip
- # in that case.
- if ($in_NAME{$addr} && $paragraph =~ /\S/) {
- $self->textblock($paragraph, $line_num, $pod_para);
+ # Keep separate tabs on C<>, F<>, and L<> directives, and one
+ # especially for C<> ones.
+ if ($in_CFL{$addr}) {
+ $CFL_text{$addr} .= $text;
+ $C_text{$addr} .= $text if defined $C_text{$addr};
+ }
+ else {
+ # This variable is updated instead in the corresponding C, F, or L
+ # handler.
+ $running_CFL_text{$addr} .= $text;
}
- my @lines = split /^/, $paragraph;
- for my $i (0 .. @lines - 1) {
- if ( my $encoding = $seen_encoding_cmd{$addr} ) {
- require Encode;
- $lines[$i] = Encode::decode($encoding, $lines[$i]);
+ # do this line-by-line so we can get the right line number
+ my @lines = split /^/, $running_simple_text{$addr};
+ for my $i (0..$#lines) {
+ if ($lines[$i] =~ m/\N{REPLACEMENT CHARACTER}/) {
+ $self->poderror({ -line => $start_line{$addr} + $i,
+ -msg => $replacement_character,
+ parameter => "possibly invalid ". $self->encoding . " input at character " . pos $lines[$i],
+ });
}
- $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)",
- });
}
+ return $return;
}
- sub textblock {
- my ($self, $paragraph, $line_num, $pod_para) = @_;
- $self->check_encoding($paragraph, $line_num, $pod_para);
+ # The start_FOO routines check that somehow a C<> construct hasn't escaped
+ # without being checked, and initialize things, and call the parent
+ # class's equivalent routine.
- $self->SUPER::textblock($paragraph, $line_num, $pod_para);
+ # The end_FOO routines close things off, and check the text that has been
+ # accumulated for FOO, then call the parent's corresponding routine.
+
+ sub start_Para {
+ my $self = shift;
+ check_see_but_not_link($self);
- my ($file, $line) = $pod_para->file_line;
my $addr = Scalar::Util::refaddr $self;
- if ($in_NAME{$addr}) {
- if (! $self->name) {
- my $text = $self->interpolate($paragraph, $line_num);
- if ($text =~ /^\s*(\S+?)\s*$/) {
- $self->name($1);
- $self->poderror({ -line => $line, -file => $file,
- -msg => $missing_name_description,
- parameter => $1});
- }
- }
+ $start_line{$addr} = $_[0]->{start_line};
+ $running_CFL_text{$addr} = "";
+ $running_simple_text{$addr} = "";
+ return $self->SUPER::start_Para(@_);
+ }
+
+ sub start_item_text {
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+ $start_line{$addr} = $_[0]->{start_line};
+ $running_CFL_text{$addr} = "";
+ $running_simple_text{$addr} = "";
+
+ # This is the only =item that is linkable
+ $linkable_item{$addr} = 1;
+
+ return $self->SUPER::start_item_text(@_);
+ }
+
+ sub start_item_number {
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+ $start_line{$addr} = $_[0]->{start_line};
+ $running_CFL_text{$addr} = "";
+ $running_simple_text{$addr} = "";
+
+ return $self->SUPER::start_item_number(@_);
+ }
+
+ sub start_item_bullet {
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+ $start_line{$addr} = $_[0]->{start_line};
+ $running_CFL_text{$addr} = "";
+ $running_simple_text{$addr} = "";
+
+ return $self->SUPER::start_item_bullet(@_);
+ }
+
+ sub end_item { # No difference in =item types endings
+ my $self = shift;
+ check_see_but_not_link($self);
+ return $self->SUPER::end_item(@_);
+ }
+
+ sub start_over {
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+ $start_line{$addr} = $_[0]->{start_line};
+ $running_CFL_text{$addr} = "";
+ $running_simple_text{$addr} = "";
+
+ # Save this indent on a stack, and keep track of total indent
+ my $indent = $_[0]{'indent'};
+ push @{$indents{$addr}}, $indent;
+ $current_indent{$addr} += $indent;
+
+ return $self->SUPER::start_over(@_);
+ }
+
+ sub end_over_bullet { shift->end_over(@_) }
+ sub end_over_number { shift->end_over(@_) }
+ sub end_over_text { shift->end_over(@_) }
+ sub end_over_block { shift->end_over(@_) }
+ sub end_over_empty { shift->end_over(@_) }
+ sub end_over {
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+
+ # Pop current indent
+ if (@{$indents{$addr}}) {
+ $current_indent{$addr} -= pop @{$indents{$addr}};
+ }
+ else {
+ # =back without corresponding =over, but should have
+ # warned already
+ $current_indent{$addr} = 0;
}
- $paragraph = join " ", split /^/, $paragraph;
-
- # Matches something that looks like a file name, but is enclosed in
- # C<...>
- my $C_path_re = qr{ \b ( C<
- # exclude various things that have slashes
- # in them but aren't paths
- (?!
- (?: (?: s | qr | m) / ) # regexes
- | \d+/\d+> # probable fractions
- | OS/2>
- | Perl/Tk>
- | origin/blead>
- | origin/maint
- | - # File names don't begin with "-"
- )
- [-\w]+ (?: / [-\w]+ )+ (?: \. \w+ )? > )
- }x;
-
- # If looks like a reference to other documentation by containing the
- # word 'See' and then a likely pod directive, warn.
- while ($paragraph =~ m{
+ }
+
+ sub check_see_but_not_link {
+
+ # Looks through accumulated text for current element that includes the
+ # C<>, F<>, and L<> directives for ones that look like they are
+ # C<link> instead of L<link>.
+
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ return unless defined $running_CFL_text{$addr};
+
+ while ($running_CFL_text{$addr} =~ m{
( (?: \w+ \s+ )* ) # The phrase before, if any
\b [Ss]ee \s+
( ( [^L] )
>
)
( \s+ (?: under | in ) \s+ L< )?
- }xg) {
+ }xg)
+ {
my $prefix = $1 // "";
my $construct = $2; # The whole thing, like C<...>
my $type = $3;
# construct would be if it actually has L<> syntax. If it
# doesn't have that syntax, will set the module to the entire
# interior.
- $interior =~ m/ ^
- (?: [^|]+ \| )? # Optional arbitrary text ending
- # in "|"
- ( .+? ) # module, etc. name
- (?: \/ .+ )? # target within module
- $
- /xs;
- my $module = $1;
if (! defined $trailing # not referring to something in another
# section
&& $interior !~ /$non_pods/
- # C<> that look like files have their own message below, so
- # exclude them
- && $construct !~ /$C_path_re/g
-
# There can't be spaces (I think) in module names or man
# pages
- && $module !~ / \s /x
+ && $interior !~ / \s /x
# F<> that end in eg \.pl are almost certainly ok, as are
# those that look like a path with multiple "/" chars
&& $interior !~ /\/.+\//)
)
) {
- $self->poderror({ -line => $line, -file => $file,
- -msg => $see_not_linked,
+ # TODO: move the checking of $pedantic higher up
+ $self->poderror({ -line => $start_line{$addr},
+ -msg => $C_not_linked,
parameter => $construct
});
}
}
}
- while ($paragraph =~ m/$C_path_re/g) {
- my $construct = $1;
- $self->poderror({ -line => $line, -file => $file,
- -msg => $C_with_slash,
- parameter => $construct
- });
- }
- return;
+
+ undef $running_CFL_text{$addr};
}
- sub command {
- my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_;
+ sub end_Para {
+ my $self = shift;
+ check_see_but_not_link($self);
+
my $addr = Scalar::Util::refaddr $self;
- if ($cmd eq "pod") {
- $seen_pod_cmd{$addr}++;
- }
- elsif ($cmd eq "encoding") {
- my ($file, $line) = $pod_para->file_line;
- $seen_encoding_cmd{$addr} = $paragraph; # for later decoding
- if ($command_count{$addr} != 1 && $seen_pod_cmd{$addr}) {
- $self->poderror({ -line => $line, -file => $file,
- -msg => $encoding_first
- });
+ if ($in_NAME{$addr}) {
+ if ($running_simple_text{$addr} =~ /^\s*(\S+?)\s*$/) {
+ $self->poderror({ -line => $start_line{$addr},
+ -msg => $missing_name_description,
+ parameter => $1});
}
+ $in_NAME{$addr} = 0;
}
- $self->check_encoding($paragraph, $line_num, $pod_para);
-
- # Pod::Check treats all =items as linkable, but the bullet and
- # numbered lists really aren't. So keep our own list. This has to be
- # processed before SUPER is called so that the list is started before
- # the rest of it gets parsed.
- if ($cmd eq 'item') { # Not linkable if item begins with * or a digit
- $linkable_item{$addr} = ($paragraph !~ / ^ \s*
- (?: [*]
- | \d+ \.? (?: \$ | \s+ )
- )/x)
- ? 1
- : 0;
+ $self->SUPER::end_Para(@_);
+ }
+
+ sub start_head1 {
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+ $start_line{$addr} = $_[0]->{start_line};
+ $running_CFL_text{$addr} = "";
+ $running_simple_text{$addr} = "";
+ return $self->SUPER::start_head1(@_);
+ }
+
+ sub end_head1 { # This is called at the end of the =head line.
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+
+ $in_NAME{$addr} = 1 if $running_simple_text{$addr} eq 'NAME';
+ return $self->SUPER::end_head(@_);
+ }
+
+ sub start_Verbatim {
+ my $self = shift;
+ check_see_but_not_link($self);
+
+ my $addr = Scalar::Util::refaddr $self;
+ $running_simple_text{$addr} = "";
+ $start_line{$addr} = $_[0]->{start_line};
+ return $self->SUPER::start_Verbatim(@_);
+ }
+
+ sub end_Verbatim {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ # Pick up the name if it looks like one, since the parent class
+ # doesn't handle verbatim NAMEs
+ if ($in_NAME{$addr}
+ && $running_simple_text{$addr} =~ /^\s*(\S+?)\s*[,-]/)
+ {
+ $self->name($1);
}
- $self->SUPER::command($cmd, $paragraph, $line_num, $pod_para);
-
- $command_count{$addr}++;
-
- $in_NAME{$addr} = 0; # Will change to 1 below if necessary
- $in_begin{$addr} = 0; # ibid
- if ($cmd eq 'over') {
- my $text = $self->interpolate($paragraph, $line_num);
- my $indent = 4; # default
- $indent = $1 if $text && $text =~ /^\s*(\d+)\s*$/;
- push @{$indents{$addr}}, $indent;
- $current_indent{$addr} += $indent;
+
+ my $indent = $self->get_current_indent;
+
+ # Look at each line to verify it is short enough
+ my @lines = split /^/, $running_simple_text{$addr};
+ for my $i (0 .. @lines - 1) {
+ $lines[$i] =~ s/\s+$//;
+ my $exceeds = length(Text::Tabs::expand($lines[$i]))
+ + $indent - $MAX_LINE_LENGTH;
+ next unless $exceeds > 0;
+
+ $self->poderror({ -line => $start_line{$addr} + $i,
+ -msg => $line_length,
+ parameter => "+$exceeds (including " . ($indent - $INDENT) . " from =over's)",
+ });
}
- elsif ($cmd eq 'back') {
- if (@{$indents{$addr}}) {
- $current_indent{$addr} -= pop @{$indents{$addr}};
+
+ undef $running_simple_text{$addr};
+
+ # Parent class didn't bother to define this
+ #return $self->SUPER::SUPER::end_Verbatim(@_);
+ }
+
+ sub start_C {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $C_text{$addr} = "";
+
+ # If not in a stacked set of C<>, F<> and L<>, initialize the text for
+ # them.
+ $CFL_text{$addr} = "" if ! $in_CFL{$addr};
+ $in_CFL{$addr}++;
+
+ return $self->SUPER::start_C(@_);
+ }
+
+ sub start_F {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $CFL_text{$addr} = "" if ! $in_CFL{$addr};
+ $in_CFL{$addr}++;
+ return $self->SUPER::start_F(@_);
+ }
+
+ sub start_L {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $CFL_text{$addr} = "" if ! $in_CFL{$addr};
+ $in_CFL{$addr}++;
+ return $self->SUPER::start_L(@_);
+ }
+
+ sub end_C {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ # Warn if looks like a file or link enclosed instead by this C<>
+ if ($C_text{$addr} =~ qr/^ $C_path_re $/x) {
+ # Here it does look like it could be be a file path or a link.
+ # But some varieties of regex patterns could also fit with what we
+ # have so far. Weed those out as best we can. '/foo/' is almost
+ # certainly meant to be a pattern, as is '/foo/g'.
+ my $is_pattern;
+ if ($C_text{$addr} !~ qr| ^ / [^/]* / ( [msixpodualngcr]* ) $ |x) {
+ $is_pattern = 0;
}
else {
- # =back without corresponding =over, but should have
- # warned already
- $current_indent{$addr} = 0;
- }
- }
- elsif ($cmd =~ /^head/) {
- if (! $in_begin{$addr}) {
- # If a particular formatter, then this command doesn't really
- # apply
- $current_indent{$addr} = 0;
- undef @{$indents{$addr}};
+ # Here, it looks like a pattern potentially followed by some
+ # modifiers. To make doubly sure, don't count as patterns
+ # those constructs which have more occurrences (generally 1)
+ # of a modifier than is legal.
+ my %counts;
+ map { $counts{$_}++ } split "", $1;
+ foreach my $modifier (keys %counts) {
+ if ($counts{$modifier} > (($modifier eq 'a')
+ ? 2
+ : 1))
+ {
+ $is_pattern = 0;
+ last;
+ }
+ }
+ $is_pattern = 1 unless defined $is_pattern;
}
- my $text = $self->interpolate($paragraph, $line_num);
- $in_NAME{$addr} = 1 if $cmd eq 'head1'
- && $text && $text =~ /^NAME\b/;
- }
- elsif ($cmd eq 'begin') {
- $in_begin{$addr} = 1;
+ unless ($is_pattern) {
+ $self->poderror({ -line => $start_line{$addr},
+ -msg => $C_with_slash,
+ parameter => "C<$C_text{$addr}>"
+ });
+ }
}
+ undef $C_text{$addr};
+
+ # Add the current text to the running total. This was not done in
+ # handle_text(), because it just sees the plain text of the innermost
+ # stacked directive. We want to keep all the directive names
+ # enclosing the text. Otherwise the fact that C<L<foobar>> is to a
+ # link would be lost, as the L<> would be gone.
+ $CFL_text{$addr} = "C<$CFL_text{$addr}>";
+
+ # Add this text to the the whole running total only if popping this
+ # directive off the stack leaves it empty. As long as something is on
+ # the stack, it gets added to $CFL_text (just above). It is only
+ # entirely constructed when the stack is empty.
+ $in_CFL{$addr}--;
+ $running_CFL_text{$addr} .= $CFL_text{$addr} if ! $in_CFL{$addr};
+
+ return $self->SUPER::end_C(@_);
+ }
- return;
+ sub end_F {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $CFL_text{$addr} = "F<$CFL_text{$addr}>";
+ $in_CFL{$addr}--;
+ $running_CFL_text{$addr} .= $CFL_text{$addr} if ! $in_CFL{$addr};
+ return $self->SUPER::end_F(@_);
}
- sub hyperlink {
+ sub end_L {
my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
- my $page;
- if ($_[0] && ($page = $_[0][1]{'-page'})) {
- my $node = $_[0][1]{'-node'};
+ $CFL_text{$addr} = "L<$CFL_text{$addr}>";
+ $in_CFL{$addr}--;
+ $running_CFL_text{$addr} .= $CFL_text{$addr} if ! $in_CFL{$addr};
+ return $self->SUPER::end_L(@_);
+ }
+
+ sub start_X {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $in_X{$addr} = 1;
+ return $self->SUPER::start_X(@_);
+ }
+
+ sub end_X {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $in_X{$addr} = 0;
+ return $self->SUPER::end_X(@_);
+ }
+
+ sub start_for {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $in_for{$addr} = 1;
+ return $self->SUPER::start_for(@_);
+ }
+
+ sub end_for {
+ my $self = shift;
+ my $addr = Scalar::Util::refaddr $self;
+
+ $in_for{$addr} = 0;
+ return $self->SUPER::end_for(@_);
+ }
+
+ sub hyperlink {
+ my ($self, $link) = @_;
+
+ if ($link && $link->type eq 'pod') {
+ my $page = $link->page;
+ my $node = $link->node;
# If the hyperlink is to an interior node of another page, save it
# so that we can see if we need to parse normally skipped files.
# Ignore certain placeholder links in perldelta. Check if the
# link is page-level, and also check if to a node within the page
- if ($self->name && $self->name eq "perldelta"
- && ((grep { $page eq $_ } @perldelta_ignore_links)
- || ($node
+ if ( $self->name && $self->name eq "perldelta"
+ && (( grep { $page eq $_ } @perldelta_ignore_links)
+ || ( $node
&& (grep { "$page/$node" eq $_ } @perldelta_ignore_links)
))) {
return;
}
}
- return $self->SUPER::hyperlink($_[0]);
+
+ return $self->SUPER::hyperlink($link);
}
sub node {
delete $problems{$self->get_filename};
return;
}
-}
-package Tie_Array_to_FH { # So printing actually goes to an array
+ sub parse_from_file {
+ # This overrides the super class method so that if an open fails on a
+ # transitory file, it doesn't croak. It returns 1 if it did find the
+ # file, 0 if it didn't
- my %array;
-
- sub TIEHANDLE {
- my $class = shift;
- my $array_ref = shift;
+ my $self = shift;
+ my $filename = shift;
+ # ignores 2nd param, which is output file. Always uses undef
- my $self = bless \do{ my $anonymous_scalar }, $class;
- $array{Scalar::Util::refaddr $self} = $array_ref;
+ if (open my $in_fh, '<:bytes', $filename) {
+ $self->SUPER::parse_from_file($in_fh, undef);
+ close $in_fh;
+ return 1;
+ }
- return $self;
- }
+ # If couldn't open file, perhaps it was transitory, and hence not an error
+ return 0 unless -e $filename;
- sub PRINT {
- my $self = shift;
- push @{$array{Scalar::Util::refaddr $self}}, @_;
- return 1;
+ die "Can't open '$filename': $!\n";
}
}
-
-my %filename_to_checker; # Map a filename to it's pod checker object
-my %id_to_checker; # Map a checksum to it's pod checker object
-my %nodes; # key is filename, values are nodes in that file.
-my %nodes_first_word; # same, but value is first word of each node
-my %valid_modules; # List of modules known to exist outside us.
-my %digests; # checksums of files, whose names are the keys
-my %filename_to_pod; # Map a filename to its pod NAME
+my %filename_to_checker; # Map a filename to its pod checker object
+my %id_to_checker; # Map a checksum to its pod checker object
+my %nodes; # key is filename, values are nodes in that file.
+my %nodes_first_word; # same, but value is first word of each node
+my %valid_modules; # List of modules known to exist outside us.
+my %digests; # checksums of files, whose names are the keys
+my %filename_to_pod; # Map a filename to its pod NAME
my %files_with_unknown_issues;
my %files_with_fixes;
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/) {
note("-----\n" . Text::Tabs::expand("$total\tknown potential issues"));
if (%suppressed_files) {
note("\nFiles that have all messages of at least one type suppressed:");
- note(join ",", keys %suppressed_files);
+ note(join ",", sort keys %suppressed_files);
}
exit 0;
}
# doesn't exist
my $filename = shift;
- my @pod;
-
- # Arrange for the output of Pod::Parser to be collected in an array we can
- # look at instead of being printed
- tie *ALREADY_FH, 'Tie_Array_to_FH', \@pod;
if (open my $in_fh, '<:bytes', $filename) {
- my $parser = Pod::Parser->new();
- $parser->parse_from_filehandle($in_fh, *ALREADY_FH);
- close $in_fh;
-
- return join "", @pod
+ use Pod::Simple::JustPod;
+ my $parser = Pod::Simple::JustPod->new();
+ $parser->no_errata_section(1);
+ $parser->no_whining(1);
+ $parser->source_filename($filename);
+ my $output;
+ $parser->output_string( \$output );
+ $parser->parse_lines( <$in_fh>, undef );
+ close $in_fh;
+
+ return $output;
}
# The file should already have been opened once to get here, so if that
my $digest = Digest->new($digest_type);
+# This is used as a callback from File::Find::find(), which always constructs
+# pathnames using Unix separators
sub is_pod_file {
# If $_ is a pod file, add it to the lists and do other prep work.
if (-d) {
# Don't look at files in directories that are for tests, nor those
# beginning with a dot
- if ($_ eq 't' || $_ =~ /^\../) {
+ if (m!/t\z! || m!/\.!) {
$File::Find::prune = 1;
}
return;
# check if 0 length
return unless -f || -l; # Weird file types won't be pods
- if ($_ =~ /^\./ # No hidden Unix files
- || $_ =~ $non_pods) {
+ my ($leaf) = m!([^/]+)\z!;
+ if (m!/\.! # No hidden Unix files
+ || $leaf =~ $non_pods) {
note("Not considering $_") if DEBUG;
return;
}
my $filename = $File::Find::name;
# $filename is relative, like './path'. Strip that initial part away.
- # Assumes that the path separator is exactly one character.
- $filename =~ s/^\..//;
+ $filename =~ s!^\./!! or die 'Unexpected pathname "$filename"';
return if $excluded_files{canonicalize($filename)};
if ($filename =~ / (?: ^(cpan|lib|ext|dist)\/ )
| $only_for_interior_links_re
- /x) {
+ /x)
+ {
$digest->add($contents);
$digests{$filename} = $digest->digest;
# name
if ($contents =~ /\G # continue from the line after =head1
\s* # ignore any empty lines
+
+ # ignore =for paragraphs followed by empty
+ # lines
+ (?: ^ =for .*? \n (?: [^\s]*? \n )* \s* )*
+
^ \s* ( \S+?) \s* (?: [,-] | $ )/mx) {
my $name = $1;
$checker->name($name);
chdir File::Spec->updir;
# And look in this directory and all its subdirectories
- find( \&is_pod_file, '.');
+ find( {wanted => \&is_pod_file, no_chdir => 1}, '.');
# Add ourselves to the test
push @files, "t/porting/podcheck.t";
plan (tests => scalar @files) if ! $regen;
- # Sort file names so we get consistent results, and to put cpan last,
- # preceeded by the ones that we don't generally parse. This is because both
- # these classes are generally parsed only if there is a link to the interior
- # of them, and we have to parse all others first to guarantee that they don't
- # have such a link. 'lib' files come just before these, as some of these are
- # duplicates of others. We already have figured this out when gathering the
- # data as a special case for all such files, but this, while unnecessary,
- # puts the derived file last in the output. 'readme' files come before those,
- # as those also could be duplicates of others, which are considered the
- # primary ones. These currently aren't figured out when gathering data, so
- # are done here.
- @files = sort { if ($a =~ /^cpan/) {
- return 1 if $b !~ /^cpan/;
- return lc $a cmp lc $b;
- }
- elsif ($b =~ /^cpan/) {
- return -1;
- }
- elsif ($a =~ /$only_for_interior_links_re/) {
- return 1 if $b !~ /$only_for_interior_links_re/;
- return lc $a cmp lc $b;
- }
- elsif ($b =~ /$only_for_interior_links_re/) {
- return -1;
- }
- elsif ($a =~ /^lib/) {
- return 1 if $b !~ /^lib/;
- return lc $a cmp lc $b;
- }
- elsif ($b =~ /^lib/) {
- return -1;
- } elsif ($a =~ /\breadme\b/i) {
- return 1 if $b !~ /\breadme\b/i;
- return lc $a cmp lc $b;
- }
- elsif ($b =~ /\breadme\b/i) {
- return -1;
- }
- else {
- return lc $a cmp lc $b;
- }
- }
- @files;
+# Sort file names so we get consistent results, and to put cpan last,
+# preceded by the ones that we don't generally parse. This is because both
+# these classes are generally parsed only if there is a link to the interior
+# of them, and we have to parse all others first to guarantee that they don't
+# have such a link. 'lib' files come just before these, as some of these are
+# duplicates of others. We already have figured this out when gathering the
+# data as a special case for all such files, but this, while unnecessary,
+# puts the derived file last in the output. 'readme' files come before those,
+# as those also could be duplicates of others, which are considered the
+# primary ones. These currently aren't figured out when gathering data, so
+# are done here.
+@files = sort { if ($a =~ /^cpan/) {
+ return 1 if $b !~ /^cpan/;
+ return lc $a cmp lc $b;
+ }
+ elsif ($b =~ /^cpan/) {
+ return -1;
+ }
+ elsif ($a =~ /$only_for_interior_links_re/) {
+ return 1 if $b !~ /$only_for_interior_links_re/;
+ return lc $a cmp lc $b;
+ }
+ elsif ($b =~ /$only_for_interior_links_re/) {
+ return -1;
+ }
+ elsif ($a =~ /^lib/) {
+ return 1 if $b !~ /^lib/;
+ return lc $a cmp lc $b;
+ }
+ elsif ($b =~ /^lib/) {
+ return -1;
+ } elsif ($a =~ /\breadme\b/i) {
+ return 1 if $b !~ /\breadme\b/i;
+ return lc $a cmp lc $b;
+ }
+ elsif ($b =~ /\breadme\b/i) {
+ return -1;
+ }
+ else {
+ return lc $a cmp lc $b;
+ }
+ }
+ @files;
# Now go through all the files and parse them
FILE:
# We have set the name in the checker object if there is a possibility
# that no further parsing is necessary, but otherwise do the parsing now.
if (! $checker->name) {
+ if (! $checker->parse_from_file($filename, undef)) {
+ $checker->set_skip("$filename is transitory");
+ next FILE;
+ }
$parsed = 1;
- $checker->parse_from_file($filename, undef);
}
if ($checker->num_errors() < 0) { # Returns negative if not a pod
$same = $prior_contents eq $contents;
}
+ use File::Basename 'basename';
if ($same) {
$checker->set_skip("The pod of $filename is a duplicate of "
. "the pod for $prior_filename");
&& $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/");
+ } elsif ($prior_filename =~ /^(?:cpan|ext|dist)/
+ && $filename !~ /^(?:cpan|ext|dist)/
+ && basename($prior_filename) eq basename($filename))
+ {
+ $checker->set_skip("$filename: Need to run make?");
} else { # Here have two pods with identical names that differ
$prior_checker->poderror(
{ -msg => $duplicate_name,
{
$checker->node($name) if $name;
}
- else {
- $checker->parse_from_file($filename, undef) if ! $parsed;
+ elsif (! $parsed) {
+ if (! $checker->parse_from_file($filename, undef)) {
+ $checker->set_skip("$filename is transitory");
+ next FILE;
+ }
}
# Go through everything in the file that could be an anchor that
# could be a link target. Count how many there are of the same name.
foreach my $node ($checker->linkable_nodes) {
next FILE if ! $node; # Can be empty is like '=item *'
- if (exists $nodes{$name}{$node}) {
- $nodes{$name}{$node}++;
- }
- else {
- $nodes{$name}{$node} = 1;
- }
+ $nodes{$name}{$node}++;
# Experiments have shown that cpan search can figure out the
# target of a link even if the exact wording is incorrect, as long
if (! $has_input_files) {
foreach my $filename (@files) {
next if $filename_to_checker{$filename}->get_skip;
+
my $checker = $filename_to_checker{$filename};
- foreach my $link ($checker->hyperlink) {
- my $linked_to_page = $link->[1]->page;
+ foreach my $link ($checker->hyperlinks()) {
+ my $linked_to_page = $link->page;
next unless $linked_to_page; # intra-file checks are handled by std
# Pod::Checker
+ # Currently, we assume all external links are valid
+ next if $link->type eq 'url';
# Initialize the potential message.
my %problem = ( -msg => $broken_link,
- -line => $link->[0],
+ -line => $link->line,
parameter => "to \"$linked_to_page\"",
);
# See if we have found the linked-to_file in our parse
if (exists $nodes{$linked_to_page}) {
- my $node = $link->[1]->node;
+ my $node = $link->node;
# If link is only to the page-level, already have it
next if ! $node;
- # Transform pod language to what we are expecting
- $node =~ s,E<sol>,/,g;
- $node =~ s/E<verbar>/|/g;
-
# If link is to a node that exists in the file, is ok
if ($nodes{$linked_to_page}{$node}) {
}
} # Linked-to-file not in parse; maybe is in exception list
- elsif (! exists $valid_modules{$link->[1]->page}) {
+ elsif (! exists $valid_modules{$link->page}) {
# Here, is a link to a target that we can't find. Check if
# there is an internal link on the page with the target name.
skip($skip, 1) if $skip;
my @diagnostics;
+ my $thankful_diagnostics = 0;
my $indent = ' ';
my $total_known = 0;
my $problem_count = scalar @{$problems{$filename}{$message}};
$total_known += $problem_count;
next if $known_problems{$canonical}{$message} < 0;
+
+ # If we have new problems not previously known, we output all of
+ # such problems, as we can't know which are really new and which
+ # not
if ($problem_count > $known_problems{$canonical}{$message}) {
# Here we are about to output all the messages for this type,
# 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;
$diagnostic .= "\n$indent$indent";
$diagnostic .= "$problem->{parameter}" if $problem->{parameter};
- $diagnostic .= " near line $problem->{-line}";
+ $diagnostic .= " near line $problem->{-line} of "
+ . $filename;
$diagnostic .= " $problem->{comment}" if $problem->{comment};
}
$diagnostic .= "\n";
$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;
}
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,
+ diag(join "", @diagnostics,
"See end of this test output for your options on silencing this");
}
+
+ delete $known_problems{$canonical};
}
}
+if (! $regen
+ && ! ok (keys %known_problems == 0, "The known problems database ($data_dir/known_pod_issues.dat) includes no references to non-existent files"))
+{
+ note("The following files were not found: "
+ . join ", ", sort keys %known_problems);
+ note("They will automatically be removed from the db the next time");
+ note(" cd t; ./perl -I../lib porting/podcheck.t --regen");
+ note("is run");
+}
+
my $how_to = <<EOF;
run this test script by hand, using the following formula (on
Un*x-like machines):
: "were $were_count_files files";
my $message = <<EOF;
-HOW TO GET THIS .t TO PASS
+HOW TO GET ${\__FILE__} TO PASS
There $were_count_files that had new potential problems identified.
Some of them may be real, and some of them may be false positives because
and change the count of known potential problems to -1.
EOF
- note($message);
+ diag($message);
} elsif (%files_with_fixes) {
- note(<<EOF
+ diag(<<EOF
To teach this test script that the potential problems have been fixed,
$how_to
EOF
chdir $original_dir || die "Can't change directories to $original_dir";
close_and_rename($copy_fh);
}
+
+1;
https://perl5.git.perl.org / perl5.git / blobdiff