cvs commit: modperl-2.0/Apache-Test/lib/Apache TestSort.pm TestHarness.pm

[dougm]

dougm       01/06/27 10:30:22

  Modified:    Apache-Test MANIFEST
               Apache-Test/lib/Apache TestHarness.pm
  Added:       Apache-Test/lib/Apache TestSort.pm
  Log:
  move sort routines into their own module, might be useful elsewhere
  
  Revision  Changes    Path
  1.4       +1 -0      modperl-2.0/Apache-Test/MANIFEST
  
  Index: MANIFEST
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Apache-Test/MANIFEST,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- MANIFEST  2001/06/21 07:40:07     1.3
  +++ MANIFEST  2001/06/27 17:30:14     1.4
  @@ -10,6 +10,7 @@
   lib/Apache/TestHandler.pm
   lib/Apache/TestMM.pm
   lib/Apache/TestTrace.pm
  +lib/Apache/TestSort.pm
   t/TEST
   t/ping.t
   t/request.t
  
  
  
  1.4       +2 -34     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.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- TestHarness.pm    2001/06/27 06:25:53     1.3
  +++ TestHarness.pm    2001/06/27 17:30:19     1.4
  @@ -4,6 +4,7 @@
   use warnings FATAL => 'all';
   
   use Test::Harness ();
  +use Apache::TestSort ();
   use Apache::TestTrace;
   use File::Spec::Functions qw(catfile);
   use File::Find qw(finddepth);
  @@ -61,40 +62,7 @@
           }
       }
   
  -    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
  -    }
  +    Apache::TestSort->run(\@tests, $args);
   
       Test::Harness::runtests(@tests);
   }
  
  
  
  1.1                  modperl-2.0/Apache-Test/lib/Apache/TestSort.pm
  
  Index: TestSort.pm
  ===================================================================
  package Apache::TestSort;
  
  use strict;
  use warnings FATAL => 'all';
  use Apache::TestTrace;
  
  sub repeat {
      my($list, $times) = @_;
      # a, a, b, b
      @$list = map { ($_) x $times } @$list;
  }
  
  sub rotate {
      my($list, $times) = @_;
      # a, b, a, b
      @$list = (@$list) x $times;
  }
  
  sub random {
      my($list, $times) = @_;
  
      rotate($list, $times); #XXX: allow random,repeat
  
      my $seed = $ENV{APACHE_TEST_SEED} || '';
      my $info = "";
  
      if ($seed) {
          $info = " (from APACHE_TEST_SEED env var)";
          # so we could reproduce the order
      }
      else {
          $seed = time ^ ($$ + ($$ << 15));
      }
  
      warning "Using random number seed: $seed" . $info;
  
      srand($seed);
  
      #from perlfaq4.pod
      for (my $i = @$list; --$i; ) {
        my $j = int rand ($i+1);
        next if $i == $j;
        @$list[$i,$j] = @$list[$j,$i];
      }
  }
  
  sub run {
      my($self, $list, $args) = @_;
  
      my $times = $args->{times} || 1;
      my $order = $args->{order} || 'rotate';
      my $sort = \&{$order};
  
      # re-shuffle the list according to the requested order
      if (defined &$sort) {
          $sort->($list, $times);
      }
      else {
          error "unknown order '$order'";
      }
  
  }
  
  1;