In perl.git, the branch jkeenan/refactor-podcheck has been updated <http://perl5.git.perl.org/perl.git/commitdiff/81bc6ce9a733d821451dbc95b149485771cddd27?hp=48a14e79b393757bfeeea68efa1e11d6877494fc>
- Log ----------------------------------------------------------------- commit 81bc6ce9a733d821451dbc95b149485771cddd27 Author: James E Keenan <[email protected]> Date: Sun Aug 17 12:17:47 2014 -0400 Fix global variables revealed by use of 'use strict' in PodcheckUtils.pm. M t/lib/PodcheckUtils.pm M t/porting/podcheck.t commit b5dc77d1404af0fd233a0a4d862e810329e4d2e6 Author: James E Keenan <[email protected]> Date: Sun Aug 17 10:46:06 2014 -0400 Move some variable definitions closer to where they're used. Identify variables needed within an 'if' block. M t/porting/podcheck.t ----------------------------------------------------------------------- Summary of changes: t/lib/PodcheckUtils.pm | 88 +++++++++++++++++------------- t/porting/podcheck.t | 145 +++++++++++++------------------------------------ 2 files changed, 89 insertions(+), 144 deletions(-) diff --git a/t/lib/PodcheckUtils.pm b/t/lib/PodcheckUtils.pm index 54c61c7..bcfc8aa 100644 --- a/t/lib/PodcheckUtils.pm +++ b/t/lib/PodcheckUtils.pm @@ -18,9 +18,12 @@ our @EXPORT_OK = qw( note ); use File::Spec; +use strict; our $current_test = 0; our $planned; +our $first_time = 1; + sub plan { my %plan = @_; $planned = $plan{tests} + 1; # +1 for final test that files haven't @@ -69,49 +72,48 @@ sub test_count_discrepancy { } } -{ # Closure - my $first_time = 1; - - sub output_thanks ($$$$) { # Called when an issue has been fixed - my $filename = shift; - my $original_count = shift; - my $current_count = shift; - my $message = shift; - - $files_with_fixes{$filename} = 1; - my $return; - my $fixed_count = $original_count - $current_count; - my $a_problem = ($fixed_count == 1) ? "a problem" : "multiple problems"; - my $another_problem = ($fixed_count == 1) ? "another problem" : "another set of problems"; - my $diff; - if ($message) { - $diff = <<EOF; +sub output_thanks { + # References our $first_time + # Called when an issue has been fixed + my $filename = shift; + my $original_count = shift; + my $current_count = shift; + my $message = shift; + my $files_with_fixes = shift; + + $files_with_fixes->{$filename} = 1; + my $return; + my $fixed_count = $original_count - $current_count; + my $a_problem = ($fixed_count == 1) ? "a problem" : "multiple problems"; + my $another_problem = ($fixed_count == 1) ? "another problem" : "another set of problems"; + my $diff; + if ($message) { + $diff = <<EOF; There were $original_count occurrences (now $current_count) in this pod of type "$message", EOF - } else { - $diff = <<EOF; + } else { + $diff = <<EOF; There are no longer any problems found in this pod! EOF - } + } - if ($first_time) { - $first_time = 0; - $return = <<EOF; + if ($first_time) { + $first_time = 0; + $return = <<EOF; Thanks for fixing $a_problem! $diff Now you must teach $0 that this was fixed. EOF - } - else { - $return = <<EOF + } + else { + $return = <<EOF Thanks for fixing $another_problem. $diff EOF - } - - return $return; } + + return ($return, $files_with_fixes); } sub regen_sort_valid { @@ -125,11 +127,14 @@ sub regen_sort_valid { sub analyze_one_file { my ($filename, $filename_to_checker, $regen, $problems, - $known_problems, $copy_fh, $pedantic, $line_length, $C_not_linked, $C_with_slash) = @_; + $known_problems, $copy_fh, $pedantic, $line_length, + $C_not_linked, $C_with_slash, $vms_re, $special_vms_files, $files_with_fixes, + $files_with_unknown_issues + ) = @_; my $these_problems = {}; $these_problems = $problems->{$filename}; - my $canonical = canonicalize($filename); + my $canonical = canonicalize($filename, $vms_re, $special_vms_files); SKIP: { my $skip = $filename_to_checker->{$filename}->get_skip // ""; @@ -183,9 +188,12 @@ sub analyze_one_file { $diagnostic .= " $problem->{comment}" if $problem->{comment}; } $diagnostic .= "\n"; - $files_with_unknown_issues{$filename} = 1; + $files_with_unknown_issues->{$filename} = 1; } elsif ($problem_count < $known_problems->{$canonical}{$message}) { - $diagnostic = output_thanks($filename, $known_problems->{$canonical}{$message}, $problem_count, $message); + ($diagnostic, $files_with_fixes) = output_thanks( + $filename, $known_problems->{$canonical}{$message}, $problem_count, + $message, $files_with_fixes + ); $thankful_diagnostics++; } push @diagnostics, $diagnostic if $diagnostic; @@ -202,7 +210,10 @@ sub analyze_one_file { 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); + my $diagnostic; + ($diagnostic, $files_with_fixes) = output_thanks( + $filename, $known_problems->{$canonical}{$message}, 0, $message, $files_with_fixes + ); push @diagnostics, $diagnostic if $diagnostic; $thankful_diagnostics++ if $diagnostic; } @@ -223,7 +234,7 @@ sub analyze_one_file { delete $known_problems->{$canonical}; } - return $known_problems; + return ($known_problems, $files_with_fixes, $files_with_unknown_issues); } sub non_regen_known_problems_notice { @@ -281,7 +292,7 @@ $how_to That should cause all current potential problems to be accepted by the program, so that the next time it runs, they won't be flagged. EOF - if (%files_with_fixes) { + if (%{$files_with_fixes}) { $message .= " This step will also take care of the files that have fixes in them\n"; } @@ -325,8 +336,9 @@ sub my_safer_print { # print, with error checking for outputting to db # This is to get this to work across multiple file systems, including those # that are not case sensitive. The db is stored in lower case, Un*x style, # and all file name comparisons are done that way. -sub canonicalize($) { +sub canonicalize { my $input = shift; + my ($vms_re, $special_vms_files) = @_; my ($volume, $directories, $file) = File::Spec->splitpath(File::Spec->canonpath($input)); # Assumes $volume is constant for everything in this directory structure @@ -342,7 +354,7 @@ sub canonicalize($) { # populated with these files. if ($^O eq 'VMS' && $file =~ / ( $vms_re ) $ /x - && ! exists $special_vms_files{$file}) + && ! exists $special_vms_files->{$file}) { $file =~ s/ $1 $ //x; } diff --git a/t/porting/podcheck.t b/t/porting/podcheck.t index 3d916b4..de7fed8 100644 --- a/t/porting/podcheck.t +++ b/t/porting/podcheck.t @@ -296,33 +296,6 @@ my $vms_re = qr/ \. (?: com )? /x; # same way that that the special vms ones are. This hash lists those. my %special_vms_files; -# This is to get this to work across multiple file systems, including those -# that are not case sensitive. The db is stored in lower case, Un*x style, -# and all file name comparisons are done that way. -#sub canonicalize($) { -# my $input = shift; -# my ($volume, $directories, $file) -# = File::Spec->splitpath(File::Spec->canonpath($input)); -# # Assumes $volume is constant for everything in this directory structure -# $directories = "" if ! $directories; -# $file = "" if ! $file; -# $file = lc join '/', File::Spec->splitdir($directories), $file; -# $file =~ s! / /+ !/!gx; # Multiple slashes => single slash -# -# # The db is stored without the special suffixes that are there in VMS, so -# # strip them off to get the comparable name. But some files on all -# # platforms have these suffixes, so this shouldn't happen for them, as any -# # of their db entries will have the suffixes in them. The hash has been -# # populated with these files. -# if ($^O eq 'VMS' -# && $file =~ / ( $vms_re ) $ /x -# && ! exists $special_vms_files{$file}) -# { -# $file =~ s/ $1 $ //x; -# } -# return $file; -#} - ##################################################### # HOW IT WORKS (in general) # @@ -372,9 +345,6 @@ 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 $broken_link = "Apparent broken link"; -my $broken_internal_link = "Apparent internal link is missing its forward slash"; -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)"; @@ -396,22 +366,22 @@ my $dl_ext = $Config{'dlext'}; $dl_ext =~ tr/.//d; # Not really pods, but can look like them. my %excluded_files = ( - PodcheckUtils::canonicalize("lib/unicore/mktables") => 1, - PodcheckUtils::canonicalize("Porting/make-rmg-checklist") => 1, + PodcheckUtils::canonicalize("lib/unicore/mktables", $vms_re, \%special_vms_files) => 1, + PodcheckUtils::canonicalize("Porting/make-rmg-checklist", $vms_re, \%special_vms_files) => 1, # this one is a POD, but unfinished, so skip # it for now - PodcheckUtils::canonicalize("Porting/perl5200delta.pod") => 1, - PodcheckUtils::canonicalize("Porting/perldelta_template.pod") => 1, - PodcheckUtils::canonicalize("regen/feature.pl") => 1, - PodcheckUtils::canonicalize("regen/warnings.pl") => 1, - PodcheckUtils::canonicalize("autodoc.pl") => 1, - PodcheckUtils::canonicalize("configpm") => 1, - PodcheckUtils::canonicalize("miniperl") => 1, - PodcheckUtils::canonicalize("perl") => 1, - PodcheckUtils::canonicalize('cpan/Pod-Perldoc/corpus/no-head.pod') => 1, - PodcheckUtils::canonicalize('cpan/Pod-Perldoc/corpus/perlfunc.pod') => 1, - PodcheckUtils::canonicalize('cpan/Pod-Perldoc/corpus/utf8.pod') => 1, - PodcheckUtils::canonicalize("lib/unicore/mktables") => 1, + PodcheckUtils::canonicalize("Porting/perl5200delta.pod", $vms_re, \%special_vms_files) => 1, + PodcheckUtils::canonicalize("Porting/perldelta_template.pod", $vms_re, \%special_vms_files) => 1, + PodcheckUtils::canonicalize("regen/feature.pl", $vms_re, \%special_vms_files) => 1, + PodcheckUtils::canonicalize("regen/warnings.pl", $vms_re, \%special_vms_files) => 1, + PodcheckUtils::canonicalize("autodoc.pl", $vms_re, \%special_vms_files) => 1, + PodcheckUtils::canonicalize("configpm", $vms_re, \%special_vms_files) => 1, + PodcheckUtils::canonicalize("miniperl", $vms_re, \%special_vms_files) => 1, + PodcheckUtils::canonicalize("perl", $vms_re, \%special_vms_files) => 1, + PodcheckUtils::canonicalize('cpan/Pod-Perldoc/corpus/no-head.pod', $vms_re, \%special_vms_files) => 1, + PodcheckUtils::canonicalize('cpan/Pod-Perldoc/corpus/perlfunc.pod', $vms_re, \%special_vms_files) => 1, + PodcheckUtils::canonicalize('cpan/Pod-Perldoc/corpus/utf8.pod', $vms_re, \%special_vms_files) => 1, + PodcheckUtils::canonicalize("lib/unicore/mktables", $vms_re, \%special_vms_files) => 1, ); # This list should not include anything for which case sensitivity is @@ -469,7 +439,7 @@ while (<$manifest_fh>) { $special_vms_files{$1} = 1; } if (/ ^ ( [^\t]* \. PL ) \t /x) { - $excluded_files{PodcheckUtils::canonicalize($1)} = 1; + $excluded_files{PodcheckUtils::canonicalize($1, $vms_re, \%special_vms_files)} = 1; } } close $manifest_fh, or die "Can't close $MANIFEST"; @@ -1151,8 +1121,6 @@ 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 $data_fh; open $data_fh, '<:bytes', $known_issues or die "Can't open $known_issues"; @@ -1258,61 +1226,6 @@ unless ($do_deltas) { /x; } -#{ # Closure -# my $first_time = 1; -# -# sub output_thanks ($$$$) { # Called when an issue has been fixed -# my $filename = shift; -# my $original_count = shift; -# my $current_count = shift; -# my $message = shift; -# -# $files_with_fixes{$filename} = 1; -# my $return; -# my $fixed_count = $original_count - $current_count; -# my $a_problem = ($fixed_count == 1) ? "a problem" : "multiple problems"; -# my $another_problem = ($fixed_count == 1) ? "another problem" : "another set of problems"; -# my $diff; -# if ($message) { -# $diff = <<EOF; -#There were $original_count occurrences (now $current_count) in this pod of type -#"$message", -#EOF -# } else { -# $diff = <<EOF; -#There are no longer any problems found in this pod! -#EOF -# } -# -# if ($first_time) { -# $first_time = 0; -# $return = <<EOF; -#Thanks for fixing $a_problem! -#$diff -#Now you must teach $0 that this was fixed. -#EOF -# } -# else { -# $return = <<EOF -#Thanks for fixing $another_problem. -#$diff -#EOF -# } -# -# return $return; -# } -#} - -#sub my_safer_print { # print, with error checking for outputting to db -# my ($fh, @lines) = @_; -# -# if (! print $fh @lines) { -# my $save_error = $!; -# close($fh); -# die "Write failure: $save_error"; -# } -#} - sub extract_pod { # Extracts just the pod from a file; returns undef if file # doesn't exist my $filename = shift; @@ -1370,7 +1283,7 @@ sub is_pod_file { # $filename is relative, like './path'. Strip that initial part away. $filename =~ s!^\./!! or die 'Unexpected pathname "$filename"'; - return if $excluded_files{PodcheckUtils::canonicalize($filename)}; + return if $excluded_files{PodcheckUtils::canonicalize($filename, $vms_re, \%special_vms_files)}; my $contents = do { local $/; @@ -1748,6 +1661,20 @@ foreach my $filename (@files) { # Here, all files have been parsed, and all links and link targets are stored. # Now go through the files again and see which don't have matches. +# $has_input_files +# @files : used but not assigned to +# %filename_to_checker : used but not assigned to +# %nodes : used but not assigned to +# %nodes_first_word : used and assigned to +# %valid_modules : used but not assigned to +# %filename_to_pod : used but not assigned to +# # 3 following are only used within this block +# $broken_link +# $broken_internal_link +# $multiple_targets +my $broken_link = "Apparent broken link"; +my $broken_internal_link = "Apparent internal link is missing its forward slash"; +my $multiple_targets = "There is more than one target"; if (! $has_input_files) { foreach my $filename (@files) { next if $filename_to_checker{$filename}->get_skip; @@ -1815,6 +1742,9 @@ if (! $has_input_files) { } } } +# XXX +# In above block, we have %problem. What is the relationship of this to +# %problems declared above and used below? # If regenerating the data file, start with the modules for which we don't # check targets. If you change the sort order, you need to run --regen before @@ -1824,15 +1754,18 @@ regen_sort_valid($regen, \%valid_modules, $copy_fh); # Now ready to output the messages. my $known_problems = \%known_problems; +my $files_with_fixes = {}; +my $files_with_unknown_issues = {}; foreach my $filename (@files) { - $known_problems = analyze_one_file($filename, \%filename_to_checker, $regen, \%problems, - $known_problems, $copy_fh, $pedantic, $line_length, $C_not_linked, $C_with_slash); + ($known_problems, $files_with_fixes, $files_with_unknown_issues) = analyze_one_file($filename, \%filename_to_checker, $regen, \%problems, + $known_problems, $copy_fh, $pedantic, $line_length, $C_not_linked, $C_with_slash, + $vms_re, \%special_vms_files, $files_with_fixes, $files_with_unknown_issues); } non_regen_known_problems_notice($regen, $known_problems); final_notification( - \%files_with_unknown_issues, \%files_with_fixes, $known_issues); + $files_with_unknown_issues, $files_with_fixes, $known_issues); regen_cleanup($regen, $original_dir, $copy_fh); -- Perl5 Master Repository
