Bug 527505: Make 001compile.t use Bugzilla->feature to determine which modules to compile

Patch by Max Kanat-Alexander <mkanat@bugzilla.org> r=LpSolit, a=mkanat

2 files changed, 75 insertions, 99 deletions

diff --git a/t/001compile.t b/t/001compile.t
index 07e47160a..4a2ea0eda 100644
--- a/t/001compile.t
+++ b/t/001compile.t
@@ -13,11 +13,11 @@
 # The Original Code are the Bugzilla Tests.
 # 
 # The Initial Developer of the Original Code is Zach Lipton
-# Portions created by Zach Lipton are 
-# Copyright (C) 2001 Zach Lipton.  All
-# Rights Reserved.
+# Portions created by Zach Lipton are Copyright (C) 2001 Zach Lipton.
+# All Rights Reserved.
 # 
 # Contributor(s): Zach Lipton <zach@zachlipton.com>
+#                 Max Kanat-Alexander <mkanat@bugzilla.org>
 
 
 #################
@@ -25,91 +25,97 @@
 ###Compilation###
 
 use strict;
+use 5.008001;
 use lib qw(. lib t);
-use Bugzilla::Constants;
 use Support::Files;
-
 use Test::More tests => scalar(@Support::Files::testitems);
 
-# Need this to get the available driver information
-use DBI;
-my @DBI_drivers = DBI->available_drivers;
+BEGIN { 
+    use_ok('Bugzilla::Constants');
+    use_ok('Bugzilla');
+}
 
-# Bugzilla requires Perl 5.8.1 now.  Checksetup will tell you this if you run it, but
-# it tests it in a polite/passive way that won't make it fail at compile time.  We'll
-# slip in a compile-time failure if it's missing here so a tinderbox on < 5.8.1 won't
-# pass and mistakenly let people think Bugzilla works on any perl below 5.8.1.
-require 5.008001;
+use constant FEATURE_FILES => (
+    jsonrpc       => ['Bugzilla/WebService/Server/JSONRPC.pm', 'jsonrpc.cgi'],
+    xmlrpc        => ['Bugzilla/WebService/Server/XMLRPC.pm', 'xmlrpc.cgi',
+                      'Bugzilla/WebService.pm', 'Bugzilla/WebService/*.pm'],
+    moving        => ['importxml.pl'],
+    auth_ldap     => ['Bugzilla/Auth/Verify/LDAP.pm'],
+    auth_radius   => ['Bugzilla/Auth/Verify/RADIUS.pm'],
+    inbound_email => ['email_in.pl'],
+    jobqueue      => ['Bugzilla/Job/*', 'Bugzilla/JobQueue.pm',
+                      'Bugzilla/JobQueue/*', 'jobqueue.pl'],
+    patch_viewer  => ['Bugzilla/Attachment/PatchReader.pm'],
+    updates       => ['Bugzilla/Update.pm'],
+);
 
-# Capture the TESTOUT from Test::More or Test::Builder for printing errors.
-# This will handle verbosity for us automatically.
-my $fh;
-{
-    local $^W = 0;  # Don't complain about non-existent filehandles
-    if (-e \*Test::More::TESTOUT) {
-        $fh = \*Test::More::TESTOUT;
-    } elsif (-e \*Test::Builder::TESTOUT) {
-        $fh = \*Test::Builder::TESTOUT;
-    } else {
-        $fh = \*STDOUT;
+sub map_files_to_feature {
+    my %features = FEATURE_FILES;
+    my %files;
+    foreach my $feature (keys %features) {
+        my @my_files = @{ $features{$feature} };
+        foreach my $pattern (@my_files) {
+            foreach my $file (glob $pattern) {
+                $files{$file} = $feature;
+            }
+        }
     }
+    return \%files;
 }
 
-my @testitems = @Support::Files::testitems;
-my $perlapp = "\"$^X\"";
-
-# Test the scripts by compiling them
-
-foreach my $file (@testitems) {
-    $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
-    next if (!$file); # skip null entries
+sub compile_file {
+    my ($file) = @_;
 
-    # Skip mod_perl.pl in all cases. It doesn't compile correctly from the command line.
-    if ($file eq 'mod_perl.pl') {
-        ok(1, "Skipping mod_perl.pl");
-        next;
+    if ($file =~ s/\.pm$//) {
+        $file =~ s{/}{::}g;
+        use_ok($file);
+        return;
     }
 
-    # Check that we have a DBI module to support the DB, if this is a database
-    # module (but not Schema)
-    if ($file =~ m#Bugzilla/DB/([^/]+)\.pm$# && $file ne "Bugzilla/DB/Schema.pm") {
-        if (!grep(lc($_) =~ /$1/i, @DBI_drivers)) {
-            ok(1,$file." - Skipping, as the DBD module not installed");
-            next;
-        }
-    }
+    open(my $fh, $file);
+    my $bang = <$fh>;
+    close $fh;
 
-    open (FILE,$file);
-    my $bang = <FILE>;
-    close (FILE);
     my $T = "";
     if ($bang =~ m/#!\S*perl\s+-.*T/) {
         $T = "T";
     }
-    my $command = "$perlapp -c$T $file 2>&1";
-    my $loginfo=`$command`;
-    #print '@@'.$loginfo.'##';
-    if ($loginfo =~ /syntax ok$/im) {
-        # Special hack due to CPAN.pm on Windows with Cygwin installed throwing
-        # strings of the form "Set up gcc environment - 3.4.4 (cygming special,
-        # gdc 0.12, using dmd 0.125)". See bug 416047 for details.
-        if (ON_WINDOWS
-            && grep($_ eq $file, 'install-module.pl', 'Bugzilla/Install/CPAN.pm'))
-        {
-            $loginfo =~ s/^Set up gcc environment.*?\n//;
+
+    my $perl = qq{"$^X"};
+    my $output = `$perl -wc$T $file 2>&1`;
+    chomp($output);
+    my $return_val = $?;
+    $output =~ s/^\Q$file\E syntax OK$//ms;
+    diag($output) if $output;
+    ok(!$return_val, $file) or diag('--ERROR');
+}
+
+my @testitems = @Support::Files::testitems;
+my $file_features = map_files_to_feature();
+
+# Test the scripts by compiling them
+foreach my $file (@testitems) {
+    # These were already compiled, above.
+    next if ($file eq 'Bugzilla.pm' or $file eq 'Bugzilla/Constants.pm');
+    SKIP: {
+        if ($file eq 'mod_perl.pl') {
+            skip 'mod_perl.pl cannot be compiled from the command line', 1;
         }
-        if ($loginfo ne "$file syntax OK\n") {
-            ok(0,$file." --WARNING");
-            print $fh $loginfo;
+        my $feature = $file_features->{$file};
+        if ($feature and !Bugzilla->feature($feature)) {
+            skip "$file: $feature not enabled", 1;
         }
-        else {
-            ok(1,$file);
+
+        # Check that we have a DBI module to support the DB, if this 
+        # is a database module (but not Schema)
+        if ($file =~ m{Bugzilla/DB/([^/]+)\.pm$}
+            and $file ne "Bugzilla/DB/Schema.pm") 
+        {
+            my $module = lc($1);
+            my $dbd = DB_MODULE->{$module}->{dbd}->{module};
+            eval("use $dbd; 1") or skip "$file: $dbd not installed", 1;
         }
-    }
-    else {
-        ok(0,$file." --ERROR");
-        print $fh $loginfo;
+
+        compile_file($file);
     }
 }      
-
-exit 0;
diff --git a/t/Support/Files.pm b/t/Support/Files.pm
index 07f1c2f6c..d24cc2264 100644
--- a/t/Support/Files.pm
+++ b/t/Support/Files.pm
@@ -25,44 +25,14 @@ package Support::Files;
 
 use File::Find;
 
-# exclude_deps is a hash of arrays listing the files to be excluded
-# if a module is not available
-#
 @additional_files = ();
-%exclude_deps = (
-    'XML::Twig' => ['importxml.pl'],
-    'Net::LDAP' => ['Bugzilla/Auth/Verify/LDAP.pm'],
-    'Authen::Radius' => ['Bugzilla/Auth/Verify/RADIUS.pm'],
-    'Email::Reply' => ['email_in.pl'],
-    'Email::MIME::Attachment::Stripper' => ['email_in.pl'],
-    'JSON::RPC' => ['Bugzilla/WebService/Server/JSONRPC.pm']
-);
-
 
 @files = glob('*');
 find(sub { push(@files, $File::Find::name) if $_ =~ /\.pm$/;}, 'Bugzilla');
 
-sub have_pkg {
-    my ($pkg) = @_;
-    my ($msg, $vnum, $vstr);
-    no strict 'refs';
-    eval { my $p; ($p = $pkg . ".pm") =~ s!::!/!g; require $p; };
-    return !($@);
-}
-
-@exclude_files    = ();
-foreach $dep (keys(%exclude_deps)) {
-    if (!have_pkg($dep)) {
-        push @exclude_files, @{$exclude_deps{$dep}};
-    }
-}
-
 sub isTestingFile {
     my ($file) = @_;
     my $exclude;
-    foreach $exclude (@exclude_files) {
-        if ($file eq $exclude) { return undef; } # get rid of excluded files.
-    }
 
     if ($file =~ /\.cgi$|\.pl$|\.pm$/) {
         return 1;