mark: A photo of Mark kneeling on top of the Taal Volcano in the Philippines. It was a long hike. (Default)
Mark Smith ([staff profile] mark) wrote in [site community profile] changelog2009-09-20 06:50 pm
  • Add Memory
  • Share This Entry

[dw-free] Many tests in t/ fail

[commit: http://hg.dwscoalition.org/dw-free/rev/81e0afe5a00f]

http://bugs.dwscoalition.org/show_bug.cgi?id=1721

Remove more useless 'use lib', add compile test.

Patch by [personal profile] szabgab.

Files modified:
  • cgi-bin/DW/BusinessRules.pm
  • cgi-bin/DW/BusinessRules/InviteCodeRequests.pm
  • cgi-bin/DW/BusinessRules/InviteCodes.pm
  • cgi-bin/DW/Worker/DistributeInvites.pm
  • cgi-bin/DW/Worker/XPostWorker.pm
  • cgi-bin/LJ/Blob.pm
  • cgi-bin/LJ/NotificationMethod/DebugLog.pm
  • cgi-bin/LJ/NotificationMethod/Email.pm
  • cgi-bin/LJ/S2.pm
  • t/00-compile.t
--------------------------------------------------------------------------------
diff -r f1133de2d63a -r 81e0afe5a00f cgi-bin/DW/BusinessRules.pm
--- a/cgi-bin/DW/BusinessRules.pm	Sun Sep 20 18:24:59 2009 +0000
+++ b/cgi-bin/DW/BusinessRules.pm	Sun Sep 20 18:50:18 2009 +0000
@@ -19,7 +19,8 @@ use strict;
 use strict;
 use warnings;
 use Carp ();
-use lib "$LJ::HOME/cgi-bin";
+use DW;
+use LJ::ModuleLoader;
 
 =head1 NAME
 
@@ -91,7 +92,7 @@ sub install_overrides {
 
     my $pkgpath = $callpkg;
     $pkgpath =~ s!::!/!g;
-    return unless -d "$LJ::HOME/cgi-bin/$pkgpath";
+    return unless -d DW->home . "/cgi-bin/$pkgpath";
 
     my %seen;
     foreach my $dpkg ( LJ::ModuleLoader->module_subclasses( $callpkg ) ) {
diff -r f1133de2d63a -r 81e0afe5a00f cgi-bin/DW/BusinessRules/InviteCodeRequests.pm
--- a/cgi-bin/DW/BusinessRules/InviteCodeRequests.pm	Sun Sep 20 18:24:59 2009 +0000
+++ b/cgi-bin/DW/BusinessRules/InviteCodeRequests.pm	Sun Sep 20 18:50:18 2009 +0000
@@ -18,7 +18,6 @@ package DW::BusinessRules::InviteCodeReq
 package DW::BusinessRules::InviteCodeRequests;
 use strict;
 use warnings;
-use lib "$LJ::HOME/cgi-bin";
 use base 'DW::BusinessRules';
 
 =head1 NAME
diff -r f1133de2d63a -r 81e0afe5a00f cgi-bin/DW/BusinessRules/InviteCodes.pm
--- a/cgi-bin/DW/BusinessRules/InviteCodes.pm	Sun Sep 20 18:24:59 2009 +0000
+++ b/cgi-bin/DW/BusinessRules/InviteCodes.pm	Sun Sep 20 18:50:18 2009 +0000
@@ -20,7 +20,6 @@ use warnings;
 use warnings;
 use Carp ();
 use List::Util ();
-use lib "$LJ::HOME/cgi-bin";
 use base 'DW::BusinessRules';
 use LJ::Lang;
 
diff -r f1133de2d63a -r 81e0afe5a00f cgi-bin/DW/Worker/DistributeInvites.pm
--- a/cgi-bin/DW/Worker/DistributeInvites.pm	Sun Sep 20 18:24:59 2009 +0000
+++ b/cgi-bin/DW/Worker/DistributeInvites.pm	Sun Sep 20 18:50:18 2009 +0000
@@ -18,7 +18,6 @@
 
 use strict;
 use warnings;
-use lib "$LJ::HOME/cgi-bin";
 
 package DW::Worker::DistributeInvites;
 use base 'TheSchwartz::Worker';
diff -r f1133de2d63a -r 81e0afe5a00f cgi-bin/DW/Worker/XPostWorker.pm
--- a/cgi-bin/DW/Worker/XPostWorker.pm	Sun Sep 20 18:24:59 2009 +0000
+++ b/cgi-bin/DW/Worker/XPostWorker.pm	Sun Sep 20 18:50:18 2009 +0000
@@ -20,7 +20,6 @@
 
 use strict;
 use warnings;
-use lib "$LJ::HOME/cgi-bin";
 
 package DW::Worker::XPostWorker;
 use base 'TheSchwartz::Worker';
diff -r f1133de2d63a -r 81e0afe5a00f cgi-bin/LJ/Blob.pm
--- a/cgi-bin/LJ/Blob.pm	Sun Sep 20 18:24:59 2009 +0000
+++ b/cgi-bin/LJ/Blob.pm	Sun Sep 20 18:50:18 2009 +0000
@@ -2,7 +2,6 @@
 
 package LJ::Blob;
 use strict;
-use lib "$LJ::HOME/cgi-bin";
 use BlobClient;
 use BlobClient::Local;
 
diff -r f1133de2d63a -r 81e0afe5a00f cgi-bin/LJ/NotificationMethod/DebugLog.pm
--- a/cgi-bin/LJ/NotificationMethod/DebugLog.pm	Sun Sep 20 18:24:59 2009 +0000
+++ b/cgi-bin/LJ/NotificationMethod/DebugLog.pm	Sun Sep 20 18:50:18 2009 +0000
@@ -3,7 +3,6 @@ use strict;
 use strict;
 use Carp qw/ croak /;
 use base 'LJ::NotificationMethod';
-use lib "$LJ::HOME/cgi-bin";
 require "weblib.pl";
 
 sub can_digest { 1 };
diff -r f1133de2d63a -r 81e0afe5a00f cgi-bin/LJ/NotificationMethod/Email.pm
--- a/cgi-bin/LJ/NotificationMethod/Email.pm	Sun Sep 20 18:24:59 2009 +0000
+++ b/cgi-bin/LJ/NotificationMethod/Email.pm	Sun Sep 20 18:50:18 2009 +0000
@@ -4,7 +4,6 @@ use Carp qw/ croak /;
 use Carp qw/ croak /;
 use base 'LJ::NotificationMethod';
 
-use lib "$LJ::HOME/cgi-bin";
 require "weblib.pl";
 
 sub can_digest { 1 };
diff -r f1133de2d63a -r 81e0afe5a00f cgi-bin/LJ/S2.pm
--- a/cgi-bin/LJ/S2.pm	Sun Sep 20 18:24:59 2009 +0000
+++ b/cgi-bin/LJ/S2.pm	Sun Sep 20 18:50:18 2009 +0000
@@ -4,7 +4,8 @@ package LJ::S2;
 package LJ::S2;
 
 use strict;
-use lib "$LJ::HOME/src/s2";
+use DW;
+use lib DW->home . "/src/s2";
 use S2;
 use S2::Color;
 use S2::Checker;
diff -r f1133de2d63a -r 81e0afe5a00f t/00-compile.t
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/t/00-compile.t	Sun Sep 20 18:50:18 2009 +0000
@@ -0,0 +1,113 @@
+#!/usrb/bin/perl -w
+use strict;
+use Test::Most;
+use File::Temp;
+use File::Find::Rule;
+use File::Basename qw(dirname);
+use File::Spec;
+
+my $dir = File::Temp::tempdir( CLEANUP => 1 );
+
+# FIXME: fix the modules that are now skipped
+# some of the modules and scripts cannot yet cleanly loaded
+# instead of waiting them to be fixed we are skipping them for now
+# They should be fixed or makred why they cannot run.
+my %SKIP = (
+    'LJ/PersistentQueue.pm'   => 'bug 1787  needs Data::Queue::Persistent',
+    'LJ/LDAP.pm'              => 'bug 1788  needs Net::LDAP',
+    'LJ/ConfCheck/General.pm' => 'needs to be integrated into LJ::ConfCheck',
+    'LJ/S2/EntryPage.pm'      => 'definition of S2::PROPS is missing (found in src/s2/S2.pm)',
+    'LJ/Widget/CreateAccountProfile.pm' => 'Bareword "LJ::BMAX_NAME"',
+    'LJ/Widget/IPPU/SettingProd.pm' => 'Bareword "LJ::get_remote"',
+    'DW/User/Edges/CommMembership.pm' => 'Undefined subroutine &DW::User::Edges::define_edge',
+    'DW/User/Edges/WatchTrust.pm'  => 'Bareword "LJ::BMAX_GRPNAME2"',
+    'DW/User/Edges.pm'   => 'Bareword "LJ::BMAX_GRPNAME2"',
+    'DW/External/XPostProtocol/LJXMLRPC.pm' => 'Cant locate object method "new" via package "DW::External::XPostProtocol::LJXMLRPC"',
+
+    'DW/Hooks/NavStrip.pm'    => 'Undefined subroutine &LJ::register_hook',
+    'DW/Hooks/SiteScheme.pm'  => 'Undefined subroutine &LJ::register_hook',
+    'LJ/Hooks/PingBack.pm'    => 'Undefined subroutine &LJ::register_hook',
+    'DW/Hooks/SSL.pm'         => 'Undefined subroutine &LJ::register_hook',
+    'DW/Hooks/Display.pm'     => 'Undefined subroutine &LJ::register_hook',
+    'DW/Hooks/Changelog.pm'   => 'Undefined subroutine &LJ::register_hook',
+    'DW/Hooks/EntryForm.pm'   => 'Undefined subroutine &LJ::register_hook',
+
+    'LJ/Test/AtomAPI.pm'      => 'needs Apache/Constants',
+    'Test/FakeApache.pm'      => 'needs Apache/Constants.pm',
+    'Apache/CompressClientFixup.pm' => 'needs Apache/Constants.pm',
+
+    'Data/ObjectDriver/Driver/DBD/SQLite.pm' => 'Bareword "DBI::SQL_BLOB"',
+    'Data/ObjectDriver/Driver/DBD/Oracle.pm' => 'no Oracle',
+
+    'cgi-bin/dw-nonfree.pl' => 'Undefined subroutine &LJ::register_hook',
+    'cgi-bin/ljdefaults.pl' => 'Cant return outside a subroutine at cgi-bin/ljdefaults.pl',    
+    'cgi-bin/modperl.pl'    => 'Cant locate object method "server" via package "Apache2::ServerUtil"',
+    'cgi-bin/lj-bml-init.pl' => 'Undefined subroutine &BML::register_isocode',
+    'cgi-bin/ljlib-local.pl' => 'Undefined subroutine &LJ::register_hook',
+    'cgi-bin/lj-bml-blocks.pl' => 'Undefined subroutine &BML::register_block',
+    'cgi-bin/ljuserpics.pl'  => 'croak is not imported',
+);
+
+my @scripts = File::Find::Rule->file->name('*.pl')->in('cgi-bin');
+my @modules = File::Find::Rule->relative->file->name('*.pm')->in('cgi-bin');
+
+
+plan tests => 2 * @scripts + 2 * @modules;
+bail_on_fail;
+
+#diag explain \@scripts;
+#diag explain \@modules;
+
+my $out = "$dir/out";
+my $err = "$dir/err";
+my $lib = File::Spec->catdir(dirname(dirname($0)), 'cgi-bin');
+
+foreach my $file (@modules) {
+    my $module = substr $file, 0, -3;
+    $module =~ s{/}{::}g;
+
+    if ($SKIP{$file}) {
+        Test::More->builder->skip($SKIP{$file}) for 1..2;
+        next;
+    }
+
+    system qq($^X -I$lib -e "require $module; print 'ok';" > $out 2>$err);
+    my $err_data = slurp($err);
+    is($err_data, '', "STDERR of $file");
+
+    my $out_data = slurp($out);
+    is($out_data, 'ok', "STDOUT of $file");
+}
+
+foreach my $file (@scripts) {
+    if ($SKIP{$file}) {
+        Test::More->builder->skip($SKIP{$file}) for 1..2;
+        next;
+    }
+
+    system qq($^X -I$lib $file > $out 2>$err);
+    my $err_data = slurp($err);
+    is($err_data, '', "STDERR of $file");
+
+    my $out_data = slurp($out);
+    is($out_data, '', "STDOUT of $file");
+}
+
+# Bail out if any of the tests failed
+BAIL_OUT("Aborting test suite") if scalar 
+    grep { not $_->{ok} } Test::More->builder->details;
+
+
+
+
+
+######################################################################
+# Support Functions
+
+sub slurp {
+    my $file = shift;
+    open my $fh, '<', $file or die $!;
+    local $/ = undef;
+    return <$fh>;
+}
+
--------------------------------------------------------------------------------