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 take2] add test skipping reasoning
Date Wed, 07 Nov 2001 07:30:44 GMT
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:stas@stason.org  http://ticketmaster.com http://apacheweek.com
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/


Mime
View raw message