this patch:
- prints the reason for the skipped test
I didn't want to complicate things, so I've changed the definition of what
a condition function should return to be:
if (true)
return 1;
else
return the reason as a string different from 1;
issues:
- Doug has mentioned that "missing foo" doesn't help much for c modules
because it doesn't explain the real reason, which can be:
o apxs is not available
o the module requires 2.0
o else
solution:
- first let's integrate this patch.
- second I suggest splitting have_module into have_module_c and
have_module_perl, or leave have_module as is for 'mod_*.c' but do add
have_module_perl.
consider:
plan ..., have_module 'constant';
for constant.pm. this will falsely satisfy the requirement with what we
have now if there is mod_constant.c and it's compiled, but constant.pm is
not available. There is no requirement for Perl modules to start with
uppercase letter.
- third IMHO tests shouldn't care about why their requirement is not
satisfied, thefore we shouldn't try to make them set the reason.
have_module() should figure out why some mod_*.c is not there. But that's
a next step and has nothing to do with this patch.
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/07 06:50:34
@@ -67,10 +67,26 @@
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 {
+ return "LWP cannot handle HTTP 1.1";
+ }
+}
+sub have_lwp {
+ require Apache::TestRequest;
+ if (Apache::TestRequest::has_lwp()) {
+ return 1;
+ }
+ else {
+ return "must have LWP installed";
+ }
+}
+
sub plan {
init_test_pm(shift) if ref $_[0];
@@ -80,24 +96,31 @@
if (@_ % 2) {
my $condition = pop @_;
my $ref = ref $condition;
- my $meets_condition = 0;
+ my $status;
if ($ref) {
if ($ref eq 'CODE') {
#plan tests $n, \&has_lwp
- $meets_condition = $condition->();
+ $status = $condition->();
}
elsif ($ref eq 'ARRAY') {
#plan tests $n, [qw(php4 rewrite)];
- $meets_condition = have_module($condition);
+ $status = 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;
+ # we have the verdict already: 1 or reason
+ $status = $condition;
}
+
+ # this shouldn't happen, must be a broken test
+ $status = 'fix me' unless defined $status;
- unless ($meets_condition) {
- print "1..0\n";
+ # tryint to emulate a dual variable (ala errno)
+ unless (length($status) == 1 and $status == 1) {
+ print "1..0 # skipped: $status \n";
exit; #XXX: Apache->exit
}
}
@@ -119,20 +142,25 @@
die "bogus module name $_" unless /^[\w:.]+$/;
eval "require $_";
#print $@ if $@;
- return 0 if $@;
+ return "cannot find $_" if $@;
}
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 {
+ return "need apache $version, but this is $cfg->{server}->{rev}";
+ }
}
sub have_perl {
@@ -141,7 +169,7 @@
for my $key ($thing, "use$thing") {
return 1 if $Config{$key} and $Config{$key} eq 'define';
}
- return 0;
+ return "Perl was built with neither $thing nor use$thing";
}
package Apache::TestToString;
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/07 06:50:34
@@ -25,7 +25,8 @@
my %other_files;
-plan tests => @pods + keys(%other_files), sub { $perlpod };
+plan tests => @pods + keys(%other_files),
+ sub { $perlpod ? 1 : "dir $vars->{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/07 06:50:34
@@ -20,7 +20,8 @@
("/getfiles-binary-$_", $vars->{$_})
} qw(httpd perl);
-plan tests => @pods + keys(%other_files), sub { $perlpod };
+plan tests => @pods + keys(%other_files),
+ sub { $perlpod ? 1 : "dir $vars->{perlpod} doesn't exist"};
my $location = "/getfiles-perl-pod";
_____________________________________________________________________
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/
