httpd-test-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Stas Bekman <s...@stason.org>
Subject [patch take3] add test skipping reasoning
Date Thu, 08 Nov 2001 07:12:37 GMT
this patch:
- 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:stas@stason.org  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);
-@EXPORT = qw(ok skip sok plan have_lwp have_http11 have_cgi
-             have_module have_apache have_perl);
+@EXPORT = qw(ok skip sok plan skip_unless have_lwp have_http11
+             have_cgi have_module have_apache have_perl);
  $VERSION = '0.01';

  %SubTests = ();
+@SkipReasons = ();

  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 = (); # reset

      Test::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";



Mime
View raw message