You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@apache.org on 2001/06/27 19:30:23 UTC
cvs commit: modperl-2.0/Apache-Test/lib/Apache TestSort.pm TestHarness.pm
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;
Re: cvs commit: modperl-2.0/Apache-Test/lib/Apache TestSort.pm
TestHarness.pm
Posted by Stas Bekman <st...@stason.org>.
On Wed, 27 Jun 2001, Doug MacEachern wrote:
> On Thu, 28 Jun 2001, Stas Bekman wrote:
>
> > what happens if $args->{order} is defined, but is none of
> > rotate|random|repeat when somebody mistypes the value or --order? This
> > code will die. My original code was just silently ignoring this option if
> > it's an unknown one.
>
> i don't think an unknown option should be silently ignored.
> it doesn't die if given an unknown option, it does this:
> error "unknown order '$order'";
>
> which you can see:
> % t/TEST -order blah
> ...
> unknown order 'blah'
> apache/cgihandler....ok
> ...
>
> i wouldn't mind if it died when given an unknown order option though.
doh! I knew that I needed a strong coffee and not tea in the morning :(
Yours is just fine.
_____________________________________________________________________
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://apachetoday.com http://eXtropia.com/
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: cvs commit: modperl-2.0/Apache-Test/lib/Apache TestSort.pm
TestHarness.pm
Posted by Doug MacEachern <do...@covalent.net>.
On Thu, 28 Jun 2001, Stas Bekman wrote:
> what happens if $args->{order} is defined, but is none of
> rotate|random|repeat when somebody mistypes the value or --order? This
> code will die. My original code was just silently ignoring this option if
> it's an unknown one.
i don't think an unknown option should be silently ignored.
it doesn't die if given an unknown option, it does this:
error "unknown order '$order'";
which you can see:
% t/TEST -order blah
...
unknown order 'blah'
apache/cgihandler....ok
...
i wouldn't mind if it died when given an unknown order option though.
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: cvs commit: modperl-2.0/Apache-Test/lib/Apache TestSort.pm
TestHarness.pm
Posted by Stas Bekman <st...@stason.org>.
On 27 Jun 2001 dougm@apache.org wrote:
> 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
[snip]
> 1.1 modperl-2.0/Apache-Test/lib/Apache/TestSort.pm
>
> Index: TestSort.pm
> ===================================================================
> package Apache::TestSort;
>
[snip]
> 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);
what happens if $args->{order} is defined, but is none of
rotate|random|repeat when somebody mistypes the value or --order? This
code will die. My original code was just silently ignoring this option if
it's an unknown one.
I've tried to add the checking at GetOptions stage:
my %order = map { $_ => 1} qw(random rotate repeat);
GetOptions(\%opts,
...
('order' => sub {
die "invalid $_[0] value: $_[1]"
unless $_[1] && $order{$_[1]};
}),
....
);
but this doesn't seem to work. It's advertised to work with non %opts call
style and I didn't find an alternative with %opts style in the manpage.
Another alternative would be to do the checking after GetOptions:
my %order = map { $_ => 1} qw(random rotate repeat);
if ($opts{order} && !$order{ $opts{order} }){
warning "invalid order: $opts{order}";
delete $opts{order};
}
of course %order, should be set only once on the top of the code and used
here and %usage.
_____________________________________________________________________
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://apachetoday.com http://eXtropia.com/
http://singlesheaven.com http://perl.apache.org http://perlmonth.com/
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org