dougm 01/12/10 21:11:40
Modified: perl-framework/Apache-Test/lib/Apache TestCommon.pm
Log:
add common test for verifying things using files.
(files = perl *.pod + httpd and perl binaries)
Revision Changes Path
1.2 +49 -0
httpd-test/perl-framework/Apache-Test/lib/Apache/TestCommon.pm
Index: TestCommon.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestCommon.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- TestCommon.pm 2001/11/21 20:59:23 1.1
+++ TestCommon.pm 2001/12/11 05:11:40 1.2
@@ -3,6 +3,8 @@
use strict;
use warnings FATAL => 'all';
+use File::Basename;
+
use Apache::Test;
use Apache::TestRequest;
use Apache::TestUtil;
@@ -37,6 +39,53 @@
ok t_cmp($length, $received, 'bytes in body');
}
+ }
+}
+
+sub run_files_test {
+ my($verify, $skip_other) = @_;
+
+ my $vars = Apache::Test::vars();
+ my $perlpod = $vars->{perlpod};
+
+ my %pod = (
+ files => [],
+ num => 0,
+ url => '/getfiles-perl-pod',
+ dir => "",
+ );
+
+ if (-d $perlpod) {
+ my @files = map { basename $_ } <$perlpod/*.pod>;
+ $pod{files} = [EMAIL PROTECTED];
+ $pod{num} = scalar @files;
+ $pod{dir} = $perlpod;
+ }
+ else {
+ push @Apache::Test::SkipReasons,
+ "dir $vars->{perlpod} does not exist";
+ }
+
+ my %other_files = ();
+
+ unless ($skip_other) { #allow to skip the large binary files
+ %other_files = map {
+ ("/getfiles-binary-$_", $vars->{$_})
+ } qw(httpd perl);
+ }
+
+ my $tests = $pod{num} + keys(%other_files);
+
+ plan tests => $tests, sub { $pod{num} and have_lwp() };
+
+ my $ua = Apache::TestRequest::user_agent();
+
+ for my $file (@{ $pod{files} }) {
+ $verify->($ua, "$pod{url}/$file", "$pod{dir}/$file");
+ }
+
+ for my $url (sort keys %other_files) {
+ $verify->($ua, $url, $other_files{$url});
}
}
