Mailing List Archive

Author: stevehay
Date: Wed Apr 1 16:19:18 2015
New Revision: 1670713

URL: http://svn.apache.org/r1670713
Log:
Fix a bunch of places where the mod_perl build process is non-deterministic due to hash randomisation. This affects the order of some build steps, order of items on some command lines, Makefile structure, and generated .xs and .pm files.

Patch by Zefram <zefram@fysh.org> from rt.cpan.org #102902.

Modified:
perl/modperl/trunk/lib/Apache2/Build.pm
perl/modperl/trunk/lib/ModPerl/BuildMM.pm
perl/modperl/trunk/lib/ModPerl/Code.pm
perl/modperl/trunk/lib/ModPerl/WrapXS.pm
perl/modperl/trunk/xs/APR/APR/Makefile.PL
perl/modperl/trunk/xs/APR/aprext/Makefile.PL
perl/modperl/trunk/xs/ModPerl/Const/Makefile.PL

Modified: perl/modperl/trunk/lib/Apache2/Build.pm
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/lib/Apache2/Build.pm?rev=1670713&r1=1670712&r2=1670713&view=diff
==============================================================================
--- perl/modperl/trunk/lib/Apache2/Build.pm (original)
+++ perl/modperl/trunk/lib/Apache2/Build.pm Wed Apr 1 16:19:18 2015
@@ -938,7 +938,7 @@ my %default_files = (

sub clean_files {
my $self = shift;
- [map { $self->default_file($_) } keys %default_files];
+ [sort map { $self->default_file($_) } keys %default_files];
}

sub default_file {
@@ -1524,7 +1524,8 @@ sub make_xs {
my @files;
my @xs_targ;

- while (my ($name, $xs) = each %{ $self->{XS} }) {
+ foreach my $name (sort keys %{ $self->{XS} }) {
+ my $xs = $self->{XS}->{$name};
#Foo/Bar.xs => Foo_Bar.c
(my $c = $xs) =~ s:.*?WrapXS/::;
$c =~ s:/:_:g;
@@ -1568,7 +1569,7 @@ my $mm_replace = join '|', keys %perl_co
my %perl_config_pm_alias_values = reverse %perl_config_pm_alias;
my @perl_config_pm_alias_values = keys %perl_config_pm_alias_values;

-my @perl_config_pm = (@perl_config_pm_alias_values, qw(cc cpprun
+my @perl_config_pm = sort(@perl_config_pm_alias_values, qw(cc cpprun
rm ranlib lib_ext obj_ext cccdlflags lddlflags optimize));

sub mm_replace {
@@ -1883,7 +1884,8 @@ EOI
#XXX short-term compat for Apache::TestConfigPerl
$libs{shared} = $libs{dso};

- while (my ($type, $lib) = each %libs) {
+ foreach my $type (sort keys %libs) {
+ my $lib = $libs{$type};
print $fh $self->canon_make_attr("lib_$type", $libs{$type});
}

@@ -1937,7 +1939,7 @@ EOI
}

my @libs;
- for my $type (map { uc } keys %libs) {
+ for my $type (sort map { uc } keys %libs) {
next unless $self->{"MP_USE_$type"};
# on win32 mod_perl.lib must come after mod_perl.so
$type eq 'STATIC'

Modified: perl/modperl/trunk/lib/ModPerl/BuildMM.pm
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/lib/ModPerl/BuildMM.pm?rev=1670713&r1=1670712&r2=1670713&view=diff
==============================================================================
--- perl/modperl/trunk/lib/ModPerl/BuildMM.pm (original)
+++ perl/modperl/trunk/lib/ModPerl/BuildMM.pm Wed Apr 1 16:19:18 2015
@@ -257,7 +257,8 @@ sub ModPerl::BuildMM::MY::postamble {
}
}

- while (my ($pm, $blib) = each %pms) {
+ foreach my $pm (sort keys %pms) {
+ my $blib = $pms{$pm};
$pm =~ s|/\./|/|g; # clean the path
$blib =~ s|/\./|/|g; # clean the path
my @segm = splitdir $blib;

Modified: perl/modperl/trunk/lib/ModPerl/Code.pm
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/lib/ModPerl/Code.pm?rev=1670713&r1=1670712&r2=1670713&view=diff
==============================================================================
--- perl/modperl/trunk/lib/ModPerl/Code.pm (original)
+++ perl/modperl/trunk/lib/ModPerl/Code.pm Wed Apr 1 16:19:18 2015
@@ -135,7 +135,7 @@ while (my ($k,$v) = each %directive_prot
}

#XXX: allow disabling of PerDir hooks on a PerDir basis
-my @hook_flags = (map { canon_uc($_) } keys %hooks);
+my @hook_flags = sort(map { canon_uc($_) } keys %hooks);
my @ithread_opts = qw(CLONE PARENT);
my %flags = (
Srv => [.'NONE', @ithread_opts, qw(ENABLE AUTOLOAD MERGE_HANDLERS),
@@ -172,7 +172,8 @@ sub path { shift->{path} }
sub handler_desc {
my ($self, $h_add, $c_add) = @_;
local $" = ",\n";
- while (my ($class, $h) = each %{ $self->{handler_index_desc} }) {
+ foreach my $class (sort keys %{ $self->{handler_index_desc} }) {
+ my $h = $self->{handler_index_desc}->{$class};
my $func = canon_func('handler', 'desc', $class);
my $array = join '_', 'MP', $func;
my $proto = "const char *$func(int idx)";
@@ -198,7 +199,8 @@ sub generate_handler_index {

my $type = 1;

- while (my ($class, $handlers) = each %{ $self->{handlers} }) {
+ foreach my $class (sort keys %{ $self->{handlers} }) {
+ my $handlers = $self->{handlers}->{$class};
my $i = 0;
my $n = @$handlers;
my $handler_type = canon_define('HANDLER_TYPE', $class);
@@ -226,7 +228,8 @@ sub generate_handler_hooks {

my @register_hooks;

- while (my ($class, $prototype) = each %{ $self->{hook_proto} }) {
+ foreach my $class (sort keys %{ $self->{hook_proto} }) {
+ my $prototype = $self->{hook_proto}->{$class};
my $callback = canon_func('callback', $class);
my $return = $prototype->{ret} eq 'void' ? '' : 'return';
my $i = -1;
@@ -294,7 +297,8 @@ $proto
switch (*name) {
EOF

- while (my ($class, $handlers) = each %{ $self->{handlers} }) {
+ foreach my $class (sort keys %{ $self->{handlers} }) {
+ my $handlers = $self->{handlers}->{$class};
my $i = 0;

for my $name (@$handlers) {
@@ -340,7 +344,8 @@ sub generate_handler_directives {

my @cmd_entries;

- while (my ($class, $handlers) = each %{ $self->{handlers} }) {
+ foreach my $class (sort keys %{ $self->{handlers} }) {
+ my $handlers = $self->{handlers}->{$class};
my $prototype = $self->{directive_proto}->{$class};
my $i = 0;

@@ -401,7 +406,8 @@ sub generate_flags {

print $h_fh "\n#define MP_SYS_$dlsrc 1\n";

- while (my ($class, $opts) = each %{ $self->{flags} }) {
+ foreach my $class (sort keys %{ $self->{flags} }) {
+ my $opts = $self->{flags}->{$class};
my @lookup = ();
my %lookup = ();
my $lookup_proto = "";
@@ -449,7 +455,7 @@ EOF
my $indent1 = " " x 4;
my $indent2 = " " x 8;
my %switch = ();
- for (keys %lookup) {
+ for (sort keys %lookup) {
if (/^(\w)/) {
my $gap = " " x ($max_len - length $_);
push @{ $switch{$1} },
@@ -458,7 +464,7 @@ EOF
}

push @lookup, '', $indent1 . "switch (*str) {";
- for (keys %switch) {
+ for (sort keys %switch) {
push @lookup, $indent1 . " case '$_':";
push @lookup, map { $indent2 . $_ } @{ $switch{$_} };
}
@@ -744,7 +750,7 @@ sub fh {

sub postamble {
my $self = shift;
- for my $name (keys %{ $self->{fh} }) {
+ for my $name (sort keys %{ $self->{fh} }) {
next unless my $av = $self->{postamble}->{$name};
print { $self->fh($name) } @$av;
}
@@ -791,7 +797,7 @@ sub generate {
@ExtUtils::Embed::Extensions = grep{$_} @ExtUtils::Embed::Extensions;

#create bootstrap method for static xs modules
- my $static_xs = [keys %{ $build->{XS} }];
+ my $static_xs = [sort keys %{ $build->{XS} }];
ExtUtils::Embed::xsinit($xsinit, 1, $static_xs);

#$self->generate_constants_pod();
@@ -931,8 +937,9 @@ EOF
sub generate_constants_lookup {
my ($h_fh, $c_fh) = @_;

- while (my ($class, $groups) = each %$Apache2::ConstantsTable) {
- my $constants = [map { @$_ } values %$groups];
+ foreach my $class (sort keys %$Apache2::ConstantsTable) {
+ my $groups = $Apache2::ConstantsTable->{$class};
+ my $constants = [sort map { @$_ } values %$groups];

constants_lookup_code($h_fh, $c_fh, $constants, $class);
}
@@ -941,7 +948,8 @@ sub generate_constants_lookup {
sub generate_constants_group_lookup {
my ($h_fh, $c_fh) = @_;

- while (my ($class, $groups) = each %$Apache2::ConstantsTable) {
+ foreach my $class (sort keys %$Apache2::ConstantsTable) {
+ my $groups = $Apache2::ConstantsTable->{$class};
constants_group_lookup_code($h_fh, $c_fh, $class, $groups);
}
}
@@ -952,7 +960,8 @@ sub constants_group_lookup_code {
my @code;

$class = canon_lc(lc $class);
- while (my ($group, $constants) = each %$groups) {
+ foreach my $group (sort keys %$groups) {
+ my $constants = $groups->{$group};
push @tags, $group;
my $name = join '_', 'MP_constants', $class, $group;
print $c_fh "\nstatic const char *$name [] = { \n",
@@ -1008,7 +1017,7 @@ sub generate_constants_pod {

require File::Path;
my $file = "Const.pod";
- for my $class (keys %data) {
+ for my $class (sort keys %data) {
my $path = catdir "tmp", $class;
File::Path::mkpath($path, 0, 0755);
my $filepath = catfile $path, $file;
@@ -1051,8 +1060,9 @@ EOF
sub generate_constants_lookup_doc {
my ($data) = @_;

- while (my ($class, $groups) = each %$Apache2::ConstantsTable) {
- my $constants = [map { @$_ } values %$groups];
+ foreach my $class (sort keys %$Apache2::ConstantsTable) {
+ my $groups = $Apache2::ConstantsTable->{$class};
+ my $constants = [sort map { @$_ } values %$groups];

constants_lookup_code_doc($constants, $class, $data);
}
@@ -1061,7 +1071,8 @@ sub generate_constants_lookup_doc {
sub generate_constants_group_lookup_doc {
my ($data) = @_;

- while (my ($class, $groups) = each %$Apache2::ConstantsTable) {
+ foreach my $class (sort keys %$Apache2::ConstantsTable) {
+ my $groups = $Apache2::ConstantsTable->{$class};
constants_group_lookup_code_doc($class, $groups, $data);
}
}

Modified: perl/modperl/trunk/lib/ModPerl/WrapXS.pm
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/lib/ModPerl/WrapXS.pm?rev=1670713&r1=1670712&r2=1670713&view=diff
==============================================================================
--- perl/modperl/trunk/lib/ModPerl/WrapXS.pm (original)
+++ perl/modperl/trunk/lib/ModPerl/WrapXS.pm Wed Apr 1 16:19:18 2015
@@ -74,7 +74,7 @@ sub get_functions {
my $self = shift;
my $typemap = $self->typemap;

- for my $entry (@{ $self->function_list() }) {
+ for my $entry (sort { $a->{name} cmp $b->{name} } @{ $self->function_list() }) {
my $func = $typemap->map_function($entry);
#print "FAILED to map $entry->{name}\n" unless $func;
next unless $func;
@@ -508,7 +508,8 @@ sub isa_str {
my $str = "";

if (my $isa = $self->typemap->{function_map}->{isa}->{$module}) {
- while (my ($sub, $base) = each %$isa) {
+ foreach my $sub (sort keys %$isa) {
+ my $base = $isa->{$sub};
#XXX cannot set isa in the BOOT: section because XSLoader local-ises
#ISA during bootstrap
# $str .= qq{ av_push(get_av("$sub\::ISA", TRUE),
@@ -713,7 +714,8 @@ sub write_lookup_method_file {
my $self = shift;

my %map = ();
- while (my ($module, $functions) = each %{ $self->{XS} }) {
+ foreach my $module (sort keys %{ $self->{XS} }) {
+ my $functions = $self->{XS}->{$module};
my $last_prefix = "";
for my $func (@$functions) {
my $class = $func->{class};
@@ -937,7 +939,7 @@ sub avail_modules {

sub preload_all_modules {
_get_modules() unless $modules;
- eval "require $_" for keys %$modules;
+ eval "require $_" for sort keys %$modules;
}

sub _print_func {
@@ -1033,7 +1035,7 @@ sub lookup_method {
my %modules = map { $_->[MODULE] => 1 } @items;
# remove dups if any (e.g. $s->add_input_filter and
# $r->add_input_filter are loaded by the same Apache2::Filter)
- my @modules = keys %modules;
+ my @modules = sort keys %modules;
my $hint;
if (@modules == 1) {
$hint = "To use method '$method' add:\n\tuse $modules[0] ();\n";
@@ -1146,7 +1148,7 @@ sub write_module_versions_file {

require mod_perl2;
$len += length '$::VERSION';
- for (@modules) {
+ for (sort @modules) {
my $ver = module_version($_);
printf $fh "package %s;\n%-${len}s = %s;\n\n",
$_, '$'.$_."::VERSION", $ver;
@@ -1173,7 +1175,8 @@ sub generate {
$self->write_export_file('exp') if Apache2::Build::AIX;
$self->write_export_file('def') if Apache2::Build::WIN32;

- while (my ($module, $functions) = each %{ $self->{XS} }) {
+ foreach my $module (sort keys %{ $self->{XS} }) {
+ my $functions = $self->{XS}->{$module};
# my ($root, $sub) = split '::', $module;
# if (-e "$self->{XS_DIR}/$root/$sub/$sub.xs") {
# $module = join '::', $root, "Wrap$sub";
@@ -1303,7 +1306,8 @@ sub write_export_file {
my $header = \&{"export_file_header_$ext"};
my $format = \&{"export_file_format_$ext"};

- while (my ($key, $table) = each %files) {
+ foreach my $key (sort keys %files) {
+ my $table = $files{$key};
my $handles = $self->open_export_files($key, $ext);

my %seen; #only write header once if this is a single file

Modified: perl/modperl/trunk/xs/APR/APR/Makefile.PL
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/xs/APR/APR/Makefile.PL?rev=1670713&r1=1670712&r2=1670713&view=diff
==============================================================================
--- perl/modperl/trunk/xs/APR/APR/Makefile.PL (original)
+++ perl/modperl/trunk/xs/APR/APR/Makefile.PL Wed Apr 1 16:19:18 2015
@@ -103,7 +103,7 @@ sub MY::postamble {

$string .= join '', map {
"$_: $src{$_}\n\t\$(CP) $src{$_} .\n";
- } keys %src;
+ } sort keys %src;

return $string;
}

Modified: perl/modperl/trunk/xs/APR/aprext/Makefile.PL
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/xs/APR/aprext/Makefile.PL?rev=1670713&r1=1670712&r2=1670713&view=diff
==============================================================================
--- perl/modperl/trunk/xs/APR/aprext/Makefile.PL (original)
+++ perl/modperl/trunk/xs/APR/aprext/Makefile.PL Wed Apr 1 16:19:18 2015
@@ -51,7 +51,7 @@ sub MY::postamble {

$string .= join '', map {
"$_: $src{$_}\n\t\$(CP) $src{$_} .\n";
- } keys %src;
+ } sort keys %src;

# BSD make needs an empty target, even if the target is specified in .PHONY
$string .= "\ndynamic ::\n";

Modified: perl/modperl/trunk/xs/ModPerl/Const/Makefile.PL
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/xs/ModPerl/Const/Makefile.PL?rev=1670713&r1=1670712&r2=1670713&view=diff
==============================================================================
--- perl/modperl/trunk/xs/ModPerl/Const/Makefile.PL (original)
+++ perl/modperl/trunk/xs/ModPerl/Const/Makefile.PL Wed Apr 1 16:19:18 2015
@@ -26,7 +26,7 @@ sub MY::postamble {

$string .= join '', map {
"$_: $src{$_}\n\t\$(CP) $src{$_} .\n";
- } keys %src;
+ } sort keys %src;

return $string;
}