This patch introduces these changes:

* 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.

_____________________________________________________________________
Stas Bekman              JAm_pH     --   Just Another mod_perl Hacker
http://stason.org/       mod_perl Guide  http://perl.apache.org/guide
mailto:[EMAIL PROTECTED]   http://apachetoday.com http://eXtropia.com/
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/

Index: Apache-Test/lib/Apache/TestHarness.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/Apache-Test/lib/Apache/TestHarness.pm,v
retrieving revision 1.1
diff -b -u -r1.1 TestHarness.pm
--- Apache-Test/lib/Apache/TestHarness.pm       2001/04/02 08:53:59     1.1
+++ Apache-Test/lib/Apache/TestHarness.pm       2001/06/26 16:56:43
@@ -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,7 +57,42 @@
                           $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);
+        do {
+            @tests[-$i,$j] = @tests[$j,-$i];
+            $j = rand(@tests - $i);
+        } while ( ++$i < @tests);
+    }
+    else {
+        # nothing
     }
 
     Test::Harness::runtests(@tests);
Index: Apache-Test/lib/Apache/TestRun.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/Apache-Test/lib/Apache/TestRun.pm,v
retrieving revision 1.9
diff -b -u -r1.9 TestRun.pm
--- Apache-Test/lib/Apache/TestRun.pm   2001/06/24 08:34:34     1.9
+++ Apache-Test/lib/Apache/TestRun.pm   2001/06/26 16:56:43
@@ -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
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]

Reply via email to