From: Jesse Vincent <jesse@bestpractical.com>
Date: Fri, 31 Jul 2009 17:17:57 +0000 (-0400)
Subject: made the manicheck actions (previously releng) into tests that always run
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2b4af749f7cacd3b6a62c0a94085b36fc60d36d6;p=p5sagit%2Fp5-mst-13.2.git

made the manicheck actions (previously releng) into tests that always run
---

diff --git a/MANIFEST b/MANIFEST
index a641990..3f5cf85 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4047,6 +4047,7 @@ t/lib/h2ph.h			Test header file for h2ph
 t/lib/h2ph.pht			Generated output from h2ph.h by h2ph, for comparison
 t/lib/locale/latin1		Part of locale.t in Latin 1
 t/lib/locale/utf8		Part of locale.t in UTF8
+t/lib/maintainers.t		Test that Porting/Maintaners.pl is up to date
 t/lib/MakeMaker/Test/NoXS.pm		MakeMaker test utilities
 t/lib/MakeMaker/Test/Setup/BFD.pm	MakeMaker test utilities
 t/lib/MakeMaker/Test/Setup/MPV.pm	MakeMaker test utilities
diff --git a/Porting/Maintainers.pm b/Porting/Maintainers.pm
index e5dde3c..8de91c4 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;
diff --git a/t/lib/maintainers.t b/t/lib/maintainers.t
new file mode 100644
index 0000000..6948136
--- /dev/null
+++ b/t/lib/maintainers.t
@@ -0,0 +1,30 @@
+#!./perl -w
+
+# Test that there are no missing Maintainers in Maintainers.PL 
+
+
+BEGIN {
+        chdir 't' if -d 't';
+        @INC = qw(../lib ../Porting);
+}
+
+use strict;
+use warnings;
+use Maintainers qw(show_results process_options finish_tap_output);
+
+chdir(".."); # The existing porting tools all expect to be run from the root
+# XXX that should be fixed
+
+{
+    local @ARGV = qw|--tap-output --checkmani|;
+    show_results(process_options());
+}
+
+{
+    local @ARGV = qw|--tap-output --checkmani lib/ ext/|;
+    show_results(process_options());
+}
+
+finish_tap_output();
+
+# EOF