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

8 files changed, 92 insertions, 117 deletions

diff --git a/Bugzilla.pm b/Bugzilla.pm
index 666b1ec15..dc275b34f 100644
--- a/Bugzilla.pm
+++ b/Bugzilla.pm
@@ -43,7 +43,6 @@ use Bugzilla::CGI;
 use Bugzilla::DB;
 use Bugzilla::Install::Localconfig qw(read_localconfig);
 use Bugzilla::Install::Requirements qw(OPTIONAL_MODULES);
-use Bugzilla::JobQueue;
 use Bugzilla::Template;
 use Bugzilla::User;
 use Bugzilla::Error;
@@ -379,6 +378,7 @@ sub logout_request {
 
 sub job_queue {
     my $class = shift;
+    require Bugzilla::JobQueue;
     $class->request_cache->{job_queue} ||= Bugzilla::JobQueue->new();
     return $class->request_cache->{job_queue};
 }
diff --git a/Bugzilla/DB.pm b/Bugzilla/DB.pm
index a702a0f60..b8a638e24 100644
--- a/Bugzilla/DB.pm
+++ b/Bugzilla/DB.pm
@@ -271,8 +271,7 @@ EOT
 }
 
 # List of abstract methods we are checking the derived class implements
-our @_abstract_methods = qw(REQUIRED_VERSION PROGRAM_NAME DBD_VERSION
-                            new sql_regexp sql_not_regexp sql_limit sql_to_days
+our @_abstract_methods = qw(new sql_regexp sql_not_regexp sql_limit sql_to_days
                             sql_date_format sql_interval bz_explain
                             sql_group_concat);
 
@@ -287,7 +286,7 @@ sub import {
         # make sure all abstract methods are implemented
         foreach my $meth (@_abstract_methods) {
             $pkg->can($meth)
-                or croak("Class $pkg does not define method $meth");
+                or die("Class $pkg does not define method $meth");
         }
     }
 
diff --git a/Bugzilla/JobQueue.pm b/Bugzilla/JobQueue.pm
index d10df9804..9e7172e2b 100644
--- a/Bugzilla/JobQueue.pm
+++ b/Bugzilla/JobQueue.pm
@@ -27,7 +27,7 @@ use strict;
 use Bugzilla::Constants;
 use Bugzilla::Error;
 use Bugzilla::Install::Util qw(install_string);
-BEGIN { eval "use base qw(TheSchwartz)"; }
+use base qw(TheSchwartz);
 
 # This maps job names for Bugzilla::JobQueue to the appropriate modules.
 # If you add new types of jobs, you should add a mapping here.
diff --git a/Bugzilla/WebService/Server/XMLRPC.pm b/Bugzilla/WebService/Server/XMLRPC.pm
index cbfb1b7f2..967235262 100644
--- a/Bugzilla/WebService/Server/XMLRPC.pm
+++ b/Bugzilla/WebService/Server/XMLRPC.pm
@@ -64,7 +64,7 @@ package Bugzilla::XMLRPC::Deserializer;
 use strict;
 # We can't use "use base" because XMLRPC::Serializer doesn't return
 # a true value.
-eval { require XMLRPC::Lite; };
+use XMLRPC::Lite;
 our @ISA = qw(XMLRPC::Deserializer);
 
 use Bugzilla::Error;
@@ -141,7 +141,7 @@ sub _validation_subs {
 
 package Bugzilla::XMLRPC::SOM;
 use strict;
-eval { require XMLRPC::Lite; };
+use XMLRPC::Lite;
 our @ISA = qw(XMLRPC::SOM);
 use Bugzilla::WebService::Util qw(taint_data);
 
@@ -165,7 +165,7 @@ use Scalar::Util qw(blessed);
 use strict;
 # We can't use "use base" because XMLRPC::Serializer doesn't return
 # a true value.
-eval { require XMLRPC::Lite; };
+use XMLRPC::Lite;
 our @ISA = qw(XMLRPC::Serializer);
 
 sub new {
diff --git a/jsonrpc.cgi b/jsonrpc.cgi
index 25fb4c175..ad910e79e 100755
--- a/jsonrpc.cgi
+++ b/jsonrpc.cgi
@@ -27,12 +27,12 @@ use Bugzilla;
 use Bugzilla::Constants;
 use Bugzilla::Error;
 use Bugzilla::WebService::Constants;
-if (!Bugzilla->feature('jsonrpc')) {
-    ThrowCodeError('feature_disabled', { feature => 'jsonrpc' });
+BEGIN {
+    if (!Bugzilla->feature('jsonrpc')) {
+        ThrowCodeError('feature_disabled', { feature => 'jsonrpc' });
+    }
 }
-
-# This eval allows runtests.pl to pass.
-eval { require Bugzilla::WebService::Server::JSONRPC; };
+use Bugzilla::WebService::Server::JSONRPC;
 
 Bugzilla->usage_mode(USAGE_MODE_JSON);
 
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;
diff --git a/xmlrpc.cgi b/xmlrpc.cgi
index 994e3a485..8b1e69f28 100755
--- a/xmlrpc.cgi
+++ b/xmlrpc.cgi
@@ -22,12 +22,12 @@ use Bugzilla;
 use Bugzilla::Constants;
 use Bugzilla::Error;
 use Bugzilla::WebService::Constants;
-if (!Bugzilla->feature('xmlrpc')) {
-    ThrowCodeError('feature_disabled', { feature => 'xmlrpc' });
+BEGIN {
+    if (!Bugzilla->feature('xmlrpc')) {
+        ThrowCodeError('feature_disabled', { feature => 'xmlrpc' });
+    }
 }
-# Use an eval here so that runtests.pl accepts this script even if SOAP-Lite
-# is not installed.
-eval { require Bugzilla::WebService::Server::XMLRPC; };
+use Bugzilla::WebService::Server::XMLRPC;
 
 Bugzilla->usage_mode(USAGE_MODE_XMLRPC);