diff options
author | Jesse Vincent <jesse@bestpractical.com> | 2009-07-31 13:17:57 -0400 |
---|---|---|
committer | Jesse Vincent <jesse@bestpractical.com> | 2009-07-31 14:26:58 -0400 |
commit | 2b4af749f7cacd3b6a62c0a94085b36fc60d36d6 (patch) | |
tree | bbbffb47859dbc8c58a6a85042c948dc03f59893 /Porting/Maintainers.pm | |
parent | 98b0b1df93cad790566f279446f0436e70599058 (diff) | |
download | perl-2b4af749f7cacd3b6a62c0a94085b36fc60d36d6.tar.gz |
made the manicheck actions (previously releng) into tests that always run
Diffstat (limited to 'Porting/Maintainers.pm')
-rw-r--r-- | Porting/Maintainers.pm | 80 |
1 files changed, 58 insertions, 22 deletions
diff --git a/Porting/Maintainers.pm b/Porting/Maintainers.pm index e5dde3c429..8de91c4827 100644 --- a/Porting/Maintainers.pm +++ b/Porting/Maintainers.pm @@ -5,6 +5,7 @@ package Maintainers; use strict; +use warnings; use lib "Porting"; # Please don't use post 5.008 features as this module is used by @@ -19,8 +20,10 @@ use vars qw(@ISA @EXPORT_OK $VERSION); @EXPORT_OK = qw(%Modules %Maintainers get_module_files get_module_pat show_results process_options files_to_modules + finish_tap_output reload_manifest); -$VERSION = 0.03; +$VERSION = 0.04; + require Exporter; use File::Find; @@ -32,8 +35,14 @@ my %MANIFEST; sub reload_manifest { %MANIFEST = (); - if (open(MANIFEST, "MANIFEST")) { - while (<MANIFEST>) { + + my $manifest_path = 'MANIFEST'; + if (! -e $manifest_path) { + $manifest_path = "../MANIFEST"; + } + + if (open(my $manfh, $manifest_path )) { + while (<$manfh>) { if (/^(\S+)/) { $MANIFEST{$1}++; } @@ -41,9 +50,9 @@ sub reload_manifest { warn "MANIFEST:$.: malformed line: $_\n"; } } - close MANIFEST; + close $manfh; } else { - die "$0: Failed to open MANIFEST for reading: $!\n"; + die "$0: Failed to open MANIFEST for reading: $!\n"; } } @@ -120,6 +129,10 @@ or --opened | file .... List the module ownership of modified or the listed files + --tap-output + Show results as valid TAP output. Currently only compatible + with --check, --checkmani + Matching is case-ignoring regexp, author matching is both by the short id and by the full name and email. A "module" may not be just a module, it may be a file or files or a subdirectory. @@ -134,6 +147,8 @@ my $Files; my $Check; my $Checkmani; my $Opened; +my $TestCounter = 0; +my $TapOutput; sub process_options { usage() @@ -145,6 +160,7 @@ sub process_options { 'check' => \$Check, 'checkmani' => \$Checkmani, 'opened' => \$Opened, + 'tap-output' => \$TapOutput, ); my @Files; @@ -287,16 +303,15 @@ sub show_results { } } elsif ($Check or $Checkmani) { if( @Files ) { - missing_maintainers( - $Checkmani - ? sub { -f $_ and exists $MANIFEST{$File::Find::name} } - : sub { /\.(?:[chty]|p[lm]|xs)\z/msx }, - @Files - ); - } - else { - duplicated_maintainers(); - } + missing_maintainers( + $Checkmani + ? sub { -f $_ and exists $MANIFEST{$File::Find::name} } + : sub { /\.(?:[chty]|p[lm]|xs)\z/msx }, + @Files + ); + } else { + duplicated_maintainers(); + } } elsif (@Files) { my $ModuleByFile = files_to_modules(@Files); for my $file (@Files) { @@ -332,15 +347,33 @@ sub maintainers_files { sub duplicated_maintainers { maintainers_files(); for my $f (keys %files) { - if ($files{$f} > 1) { - warn "File $f appears $files{$f} times in Maintainers.pl\n"; - } + if ($TapOutput) { + if ($files{$f} > 1) { + print "not ok ".++$TestCounter." - File $f appears $files{$f} times in Maintainers.pl\n"; + } else { + print "ok ".++$TestCounter." - File $f appears $files{$f} times in Maintainers.pl\n"; + } + } else { + if ($files{$f} > 1) { + warn "File $f appears $files{$f} times in Maintainers.pl\n"; + } + } } } sub warn_maintainer { my $name = shift; - warn "File $name has no maintainer\n" if not $files{$name}; + if ($TapOutput) { + if ($files{$name}) { + print "ok ".++$TestCounter." - $name has a maintainer\n"; + } else { + print "not ok ".++$TestCounter." - $name has NO maintainer\n"; + + } + + } else { + warn "File $name has no maintainer\n" if not $files{$name}; + } } sub missing_maintainers { @@ -348,10 +381,13 @@ sub missing_maintainers { maintainers_files(); my @dir; for my $d (@path) { - if( -d $d ) { push @dir, $d } else { warn_maintainer($d) } + if( -d $d ) { push @dir, $d } else { warn_maintainer($d) } } - find sub { warn_maintainer($File::Find::name) if $check->() }, @dir - if @dir; + find sub { warn_maintainer($File::Find::name) if $check->() }, @dir if @dir; +} + +sub finish_tap_output { + print "1..".$TestCounter."\n"; } 1; |