- prints the reason when a test is skipped
o automatically for the built in condition functions
o lets user provide his own condition funcs and reasoning for custom requirements
issues
- when I run filter/case test I get:
filter/case....skipped: cannot find mod_php4, cannot find case_filter
=> where the php4 requirement comes from?
- I've used push() to collect reasons, so we report as many reasons (i.e. requirements as possible at once). For the same reason I also think to change have_module to test all the modules and not to bail out on the first missing module. should I do it?
also you may want to adjust the wording for internal reasons. I'm not sure that I've picked the best ones.
I'll obviously update the docs, once the patch is in.
_____________________________________________________________________ Stas Bekman JAm_pH -- Just Another mod_perl Hacker http://stason.org/ mod_perl Guide http://perl.apache.org/guide mailto:[EMAIL PROTECTED] http://ticketmaster.com http://apacheweek.com http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
Index: Apache-Test/lib/Apache/Test.pm
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/Test.pm,v
retrieving revision 1.27
diff -u -r1.27 Test.pm
--- Apache-Test/lib/Apache/Test.pm 2001/10/20 10:35:33 1.27
+++ Apache-Test/lib/Apache/Test.pm 2001/11/08 06:50:09
@@ -8,14 +8,15 @@
use Config;
use Apache::TestConfig ();
-use vars qw(@ISA @EXPORT $VERSION %SubTests); +use vars qw(@ISA @EXPORT $VERSION %SubTests @SkipReasons);
@ISA = qw(Exporter); [EMAIL PROTECTED] = qw(ok skip sok plan have_lwp have_http11 have_cgi - have_module have_apache have_perl); [EMAIL PROTECTED] = qw(ok skip sok plan skip_unless have_lwp have_http11 + have_cgi have_module have_apache have_perl); $VERSION = '0.01';
%SubTests = (); [EMAIL PROTECTED] = ();
if (my $subtests = $ENV{HTTPD_TEST_SUBTESTS}) {
%SubTests = map { $_, 1 } split /\s+/, $subtests;
@@ -67,10 +68,28 @@
test_pm_refresh();
}-#caller will need to have required Apache::TestRequest
-*have_http11 = \&Apache::TestRequest::install_http11;
-*have_lwp = \&Apache::TestRequest::has_lwp;
+sub have_http11 {
+ require Apache::TestRequest;
+ if (Apache::TestRequest::install_http11()) {
+ return 1;
+ }
+ else {
+ push @SkipReasons, "LWP cannot handle HTTP 1.1";
+ return 0;
+ }
+}+sub have_lwp {
+ require Apache::TestRequest;
+ if (Apache::TestRequest::has_lwp()) {
+ return 1;
+ }
+ else {
+ push @SkipReasons, "must have LWP installed";
+ return 0;
+ }
+}
+
sub plan {
init_test_pm(shift) if ref $_[0];@@ -90,49 +109,83 @@
#plan tests $n, [qw(php4 rewrite)];
$meets_condition = have_module($condition);
}
+ else {
+ die "don't know how to handle a condition of type $ref";
+ }
}
else {
# we have the verdict already: true/false
$meets_condition = $condition ? 1 : 0;
}+ # tryint to emulate a dual variable (ala errno)
unless ($meets_condition) {
- print "1..0\n";
+ push @SkipReasons, "no reason given" unless @SkipReasons;
+ print "1..0 # skipped: " . join(', ', @SkipReasons) . "\n";
exit; #XXX: Apache->exit
}
}
+ @SkipReasons = (); # resetTest::plan(@_); }
+sub skip_unless {
+ my $condition = shift;
+ my $reason = shift || "no reason given";
+
+ if (ref $condition eq 'CODE' and $condition->()) {
+ return 1;
+ }
+ else {
+ push @SkipReasons, $reason;
+ return 0;
+ }
+}
+
sub have_module {
my $cfg = config();
my @modules = ref($_[0]) ? @{ $_[0] } : @_;+ my @reasons = ();
for (@modules) {
+ my $reason;
if (/^[a-z0-9_]+$/) {
my $mod = $_;
$mod = 'mod_' . $mod unless $mod =~ /^mod_/;
$mod .= '.c' unless $mod =~ /\.c$/;
next if $cfg->{modules}->{$mod};
+ if (exists $cfg->{cmodules_disabled}->{$mod}) {
+ push @SkipReasons, $cfg->{cmodules_disabled}->{$mod};
+ return 0;
+ }
}
die "bogus module name $_" unless /^[\w:.]+$/;
eval "require $_";
#print $@ if $@;
- return 0 if $@;
+ if ($@) {
+ push @SkipReasons, "cannot find $_";
+ return 0;
+ }
}return 1; }
sub have_cgi {
- [have_module('cgi') || have_module('cgid')];
+ have_module('cgi') || have_module('cgid');
}sub have_apache {
my $version = shift;
my $cfg = Apache::Test::config();
- $cfg->{server}->{rev} == $version;
+ if ($cfg->{server}->{rev} == $version) {
+ return 1;
+ }
+ else {
+ push @SkipReasons, "need apache $version, but this is $cfg->{server}->{rev}";
+ return 0;
+ }
}
sub have_perl {
@@ -141,6 +194,7 @@
for my $key ($thing, "use$thing") {
return 1 if $Config{$key} and $Config{$key} eq 'define';
}
+ push @SkipReasons, "Perl was built with neither $thing nor use$thing";
return 0;
}Index: t/apache/byterange.t =================================================================== RCS file: /home/cvs/httpd-test/perl-framework/t/apache/byterange.t,v retrieving revision 1.2 diff -u -r1.2 byterange.t --- t/apache/byterange.t 2001/09/10 17:12:37 1.2 +++ t/apache/byterange.t 2001/11/08 06:50:09 @@ -25,7 +25,8 @@
my %other_files;
-plan tests => @pods + keys(%other_files), sub { $perlpod };
+plan tests => @pods + keys(%other_files),
+ skip_unless(sub { $perlpod }, "dir $perlpod doesn't exist"); for my $url (keys %other_files) {
verify($url, $other_files{$url});
Index: t/apache/getfile.t
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/t/apache/getfile.t,v
retrieving revision 1.5
diff -u -r1.5 getfile.t
--- t/apache/getfile.t 2001/09/10 17:12:37 1.5
+++ t/apache/getfile.t 2001/11/08 06:50:09
@@ -20,7 +20,8 @@
("/getfiles-binary-$_", $vars->{$_})
} qw(httpd perl);-plan tests => @pods + keys(%other_files), sub { $perlpod };
+plan tests => @pods + keys(%other_files),
+ skip_unless(sub { $perlpod }, "dir $perlpod doesn't exist");my $location = "/getfiles-perl-pod";
