perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From sbek...@apache.org
Subject cvs commit: modperl-2.0/Apache-Test/lib/Apache TestHarness.pm TestRun.pm
Date Wed, 27 Jun 2001 06:21:25 GMT
sbekman     01/06/26 23:21:25

  Modified:    Apache-Test/lib/Apache TestHarness.pm TestRun.pm
  Log:
  * new flag: --times=N     run the tests N times
  
  * new flag: --order=order run the tests in the random order, rotate or
    repeat them
  
  * when the random order is specified, the seed will be taken from
    APACHE_TEST_SEED env var or autogenerated and printed to the STDERR,
    so one can reproduce the sequence of tests.
  
  * sorting of the tests (depending on whether test files or dirs were
    explicitly specified on the command line):
  
    o if you specify none -- everything is sorted.
    o if you specify only dirs -- evething within dirs is sorted, dirs
      order is preserved
    o if you specify file names they aren't sorted.
    o if you specify random, you get it random.
  
  * fixes the behavior when --run-tests is used and the server wasn't
    running. Now the server will start before the tests and stop after
    the tests were completed.
  
  Revision  Changes    Path
  1.2       +41 -2     modperl-2.0/Apache-Test/lib/Apache/TestHarness.pm
  
  Index: TestHarness.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Apache-Test/lib/Apache/TestHarness.pm,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- TestHarness.pm	2001/04/02 08:53:59	1.1
  +++ TestHarness.pm	2001/06/27 06:21:23	1.2
  @@ -4,6 +4,7 @@
   use warnings FATAL => 'all';
   
   use Test::Harness ();
  +use Apache::TestTrace;
   use File::Spec::Functions qw(catfile);
   use File::Find qw(finddepth);
   
  @@ -36,7 +37,7 @@
       if (@$ts) {
   	for (@$ts) {
   	    if (-d $_) {
  -		push(@tests, <$_/*.t>);
  +		push(@tests, sort <$_/*.t>);
   	    }
   	    else {
   		$_ .= ".t" unless /\.t$/;
  @@ -46,7 +47,7 @@
       }
       else {
           if ($args->{tdirs}) {
  -            push @tests, map { <$_/*.t> } @{ $args->{tdirs} };
  +            push @tests, map { sort <$_/*.t> } @{ $args->{tdirs} };
           }
           else {
               finddepth(sub {
  @@ -56,8 +57,46 @@
                             $t =~ s:^$dotslash::;
                             push @tests, $t
                         }, '.');
  +            @tests = sort @tests;
           }
       }
  +
  +    my $times = $args->{times} || 1;
  +    my $order = $args->{order} || 'rotate';
  +
  +    # re-shuffle the tests according to the requested order
  +    if ($order eq 'repeat') {
  +        # a, a, b, b
  +        @tests = map { ($_) x $times } @tests;
  +    }
  +    elsif ($order eq 'rotate') {
  +        # a, b, a, b
  +        @tests = (@tests) x $times;
  +    }
  +    elsif ($order eq 'random') {
  +        # random
  +        @tests = (@tests) x $times;
  +        my $seed = $ENV{APACHE_TEST_SEED} || '';
  +        if ($seed) {
  +            warning "Using the seed $ENV{APACHE_TEST_SEED} from APACHE_TEST_SEED env var";
  +        } else {
  +           $seed = time ^ ($$ + ($$ << 15));
  +           warning "Using the seed $seed";
  +        }
  +
  +        srand($seed); # so we could reproduce the problem
  +        my ($i,$j) = (0,0);
  +        while ($i < @tests) {
  +            $j = int rand(@tests - $i);
  +            @tests[-$i,$j] = @tests[$j,-$i];
  +            $i++;
  +        }
  +    }
  +    else {
  +        # nothing
  +    }
  +
  +    error \@tests;
   
       Test::Harness::runtests(@tests);
   }
  
  
  
  1.10      +9 -1      modperl-2.0/Apache-Test/lib/Apache/TestRun.pm
  
  Index: TestRun.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Apache-Test/lib/Apache/TestRun.pm,v
  retrieving revision 1.9
  retrieving revision 1.10
  diff -u -r1.9 -r1.10
  --- TestRun.pm	2001/06/24 08:34:34	1.9
  +++ TestRun.pm	2001/06/27 06:21:24	1.10
  @@ -15,6 +15,8 @@
   my @std_run      = qw(start-httpd run-tests stop-httpd);
   my @others       = qw(verbose configure clean help ping);
   my @flag_opts    = (@std_run, @others);
  +my @string_opts  = qw(order);
  +my @num_opts     = qw(times);
   my @list_opts    = qw(preamble postamble);
   my @hash_opts    = qw(header);
   my @exit_opts    = qw(clean help ping debug);
  @@ -23,6 +25,8 @@
   my %usage = (
      'start-httpd' => 'start the test server',
      'run-tests'   => 'run the tests',
  +   'times=N'     => 'repeat the tests N times',
  +   'order=mode'  => 'run the tests in one of the modes: (repeat|rotate|random)',
      'stop-httpd'  => 'stop the test server',
      'verbose'     => 'verbose output',
      'configure'   => 'force regeneration of httpd.conf',
  @@ -116,7 +120,8 @@
       my(%opts, %vopts, %conf_opts);
   
       GetOptions(\%opts, @flag_opts, @exit_opts,
  -               (map "$_=s", @request_opts),
  +               (map "$_=s", @request_opts,@string_opts),
  +               (map "$_=i", @num_opts),
                  (map { ("$_=s", $vopts{$_} ||= []) } @list_opts),
                  (map { ("$_=s", $vopts{$_} ||= {}) } @hash_opts));
   
  @@ -249,6 +254,7 @@
       } elsif ($self->{opts}->{'run-tests'} and !$self->{server}->ping) {
           # make sure that the server is up when -run-tests is used
           warning "the test server wasn't not running: starting it...";
  +        $self->{opts}->{'stop-httpd'} = 1;
           exit 1 unless $self->{server}->start;
       }
   }
  @@ -259,6 +265,8 @@
       my $test_opts = {
           verbose => $self->{opts}->{verbose},
           tests   => $self->{tests},
  +        times   => $self->{opts}->{times},
  +        order   => $self->{opts}->{order},
       };
   
       #make sure we use an absolute path to perl
  
  
  

Mime
View raw message