diff options
author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 15:01:31 +0000 |
---|---|---|
committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-07 15:01:31 +0000 |
commit | c9cf025fadfe043f0f2f679e10d1207d8a158bb6 (patch) | |
tree | 3a94effe0bdc0a6814d8134f4ed840d7cc6b6f19 /debian/perl-framework/Apache-Test/lib/Apache/TestSort.pm | |
parent | Adding upstream version 2.4.57. (diff) | |
download | apache2-c9cf025fadfe043f0f2f679e10d1207d8a158bb6.tar.xz apache2-c9cf025fadfe043f0f2f679e10d1207d8a158bb6.zip |
Adding debian version 2.4.57-2.debian/2.4.57-2debian
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to '')
-rw-r--r-- | debian/perl-framework/Apache-Test/lib/Apache/TestSort.pm | 76 |
1 files changed, 76 insertions, 0 deletions
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestSort.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestSort.pm new file mode 100644 index 0000000..33eabc2 --- /dev/null +++ b/debian/perl-framework/Apache-Test/lib/Apache/TestSort.pm @@ -0,0 +1,76 @@ +# Licensed to the Apache Software Foundation (ASF) under one or more +# contributor license agreements. See the NOTICE file distributed with +# this work for additional information regarding copyright ownership. +# The ASF licenses this file to You under the Apache License, Version 2.0 +# (the "License"); you may not use this file except in compliance with +# the License. You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# +package Apache::TestSort; + +use strict; +use warnings FATAL => 'all'; +use Apache::TestTrace; + +sub repeat { + my($list) = @_; + return @{$list}; +} + +sub random { + my($list) = @_; + + my $seed = $ENV{APACHE_TEST_SEED} || ''; + my $info = ""; + + if ($seed) { + $info = " (user defined)"; + # so we could reproduce the order + } + else { + $info = " (autogenerated)"; + $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 $order = $args->{order} || 'repeat'; + if ($order =~ /^\d+$/) { + #dont want an explicit -seed option but env var can be a pain + #so if -order is number assume it is the random seed + $ENV{APACHE_TEST_SEED} = $order; + $order = 'random'; + } + my $sort = \&{$order}; + + # re-shuffle the list according to the requested order + if (defined &$sort) { + $sort->($list); + } + else { + error "unknown order '$order'"; + } + +} + +1; |