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/