httpd-test-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@apache.org
Subject cvs commit: httpd-test/perl-framework/Apache-Test/lib/Apache TestCommon.pm
Date Tue, 11 Dec 2001 05:11:40 GMT
dougm       01/12/10 21:11:40

  Modified:    perl-framework/Apache-Test/lib/Apache TestCommon.pm
  Log:
  add common test for verifying things using files.
  (files = perl *.pod + httpd and perl binaries)
  
  Revision  Changes    Path
  1.2       +49 -0     httpd-test/perl-framework/Apache-Test/lib/Apache/TestCommon.pm
  
  Index: TestCommon.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestCommon.pm,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- TestCommon.pm	2001/11/21 20:59:23	1.1
  +++ TestCommon.pm	2001/12/11 05:11:40	1.2
  @@ -3,6 +3,8 @@
   use strict;
   use warnings FATAL => 'all';
   
  +use File::Basename;
  +
   use Apache::Test;
   use Apache::TestRequest;
   use Apache::TestUtil;
  @@ -37,6 +39,53 @@
   
               ok t_cmp($length, $received, 'bytes in body');
           }
  +    }
  +}
  +
  +sub run_files_test {
  +    my($verify, $skip_other) = @_;
  +
  +    my $vars = Apache::Test::vars();
  +    my $perlpod = $vars->{perlpod};
  +
  +    my %pod = (
  +        files => [],
  +        num   => 0,
  +        url   => '/getfiles-perl-pod',
  +        dir   => "",
  +    );
  +
  +    if (-d $perlpod) {
  +        my @files = map { basename $_ } <$perlpod/*.pod>;
  +        $pod{files} = \@files;
  +        $pod{num} = scalar @files;
  +        $pod{dir} = $perlpod;
  +    }
  +    else {
  +        push @Apache::Test::SkipReasons,
  +          "dir $vars->{perlpod} does not exist";
  +    }
  +
  +    my %other_files = ();
  +
  +    unless ($skip_other) { #allow to skip the large binary files
  +        %other_files = map {
  +            ("/getfiles-binary-$_", $vars->{$_})
  +        } qw(httpd perl);
  +    }
  +
  +    my $tests = $pod{num} + keys(%other_files);
  +
  +    plan tests => $tests, sub { $pod{num} and have_lwp() };
  +
  +    my $ua = Apache::TestRequest::user_agent();
  +
  +    for my $file (@{ $pod{files} }) {
  +        $verify->($ua, "$pod{url}/$file", "$pod{dir}/$file");
  +    }
  +
  +    for my $url (sort keys %other_files) {
  +        $verify->($ua, $url, $other_files{$url});
       }
   }
   
  
  
  

Mime
View raw message