Also I observe that there were previous patches to ensure most uses of
keys() were sorted. However not all of them, including diagnostics,
and various other places where the key order could be exposed to a
user.
Attached is a patch that I believe fixes any remaining uses of unsorted keys.
I took the policy that automake is not performance sensitive, at least
at the level of sorting keys, and that sorting something that is not
strictly necessary does no harm.
I admit I have not been able to properly test all of these changes,
but superficial testing does not reveal any issues.
Anyway, sorry for the misleading original bug-report.
Cheers,
Yves
--
perl -Mre=debug -e "/just|another|perl|hacker/"
commit ce352ec778e9e6bf11b9f4b81973a701b8e3cc73
Author: Yves Orton <demer...@gmail.com>
Date: Mon Feb 6 04:17:18 2017 +0100
Ensure that *all* use of keys() is deterministic
Previous changes updated most of the use of keys() to sort them first.
However various parts of the package still used unsorted keys in places
where it could affect visibile behavior. This patch audits all such uses
and switches to using sort keys, or documents that the line has been audited
and the sort is unnecessary. (One or two places I added a sort even though
it was not strictly necessary. I doubt there are performance reasons in this
code to ever skip a list-context use of keys, even if not actually required.
FWIW, I am the guy who added hash randomization to Perl 5.18.
diff --git a/bin/aclocal.in b/bin/aclocal.in
index e90bef9..92c20c3 100644
--- a/bin/aclocal.in
+++ b/bin/aclocal.in
@@ -218,7 +218,7 @@ sub xmkdir_p ($)
# Check macros in acinclude.m4. If one is not used, warn.
sub check_acinclude ()
{
- foreach my $key (keys %map)
+ foreach my $key (sort keys %map)
{
# FIXME: should print line number of acinclude.m4.
msg ('syntax', "macro '$key' defined in acinclude.m4 but never used")
@@ -790,7 +790,7 @@ sub trace_used_macros ()
# Do not trace $1 for all other macros as we do
# not need it and it might contains harmful
# characters (like newlines).
- (map { "--trace='$_:\$f::\$n'" } (keys %macro_seen)));
+ (map { "--trace='$_:\$f::\$n'" } (sort keys %macro_seen)));
verb "running $traces $configure_ac";
@@ -1190,7 +1190,7 @@ while (1)
"-I options nor AC_CONFIG_MACRO_DIR{,S} m4 macro(s)";
}
- last if write_aclocal ($output_file, keys %macro_traced);
+ last if write_aclocal ($output_file, sort keys %macro_traced);
last if $dry_run;
}
check_acinclude;
diff --git a/bin/automake.in b/bin/automake.in
index 74990b3..b1a8b2f 100644
--- a/bin/automake.in
+++ b/bin/automake.in
@@ -1421,7 +1421,7 @@ sub handle_languages ()
# suffix rule was learned), don't bother with the C stuff. But if
# anything else creeps in, then use it.
my @languages_seen = map { $languages{$extension_map{$_}}->name }
- (keys %extension_seen);
+ (sort keys %extension_seen);
@languages_seen = uniq (@languages_seen);
$needs_c = 1 if @languages_seen > 1;
if ($need_link || $needs_c)
@@ -2173,7 +2173,7 @@ sub handle_LIBOBJS
my $dir = handle_LIBOBJS_or_ALLOCA "${lt}LIBOBJS";
- foreach my $iter (keys %libsources)
+ foreach my $iter (sort keys %libsources)
{
if ($iter =~ /\.[cly]$/)
{
@@ -3363,14 +3363,14 @@ sub handle_man_pages ()
my $trans_mans = $have_trans || exists $trans_sections{$section};
my (%notrans_this_sect, %trans_this_sect);
my $expr = 'man' . $section . '_MANS';
- foreach my $varname (keys %notrans_sect_vars)
+ foreach my $varname (keys %notrans_sect_vars) # sort keys not needed
{
if ($varname =~ /$expr/)
{
$notrans_this_sect{$varname} = 1;
}
}
- foreach my $varname (keys %trans_sect_vars)
+ foreach my $varname (keys %trans_sect_vars) # sort keys not needed
{
if ($varname =~ /$expr/)
{
@@ -4403,7 +4403,7 @@ sub handle_clean
DIST_CLEAN, [],
MAINTAINER_CLEAN, []);
- foreach my $file (keys %clean_files)
+ foreach my $file (sort keys %clean_files)
{
my $when = $clean_files{$file};
prog_error 'invalid entry in %clean_files'
@@ -4473,7 +4473,7 @@ sub handle_factored_dependencies ()
. "not 'install-hook'");
# Install the -local hooks.
- foreach (keys %dependencies)
+ foreach (sort keys %dependencies)
{
# Hooks are installed on the -am targets.
s/-am$// or next;
@@ -4495,7 +4495,7 @@ sub handle_factored_dependencies ()
}
# All the required targets are phony.
- depend ('.PHONY', keys %required_targets);
+ depend ('.PHONY', sort keys %required_targets);
# Actually output gathered targets.
foreach (sort target_cmp keys %dependencies)
@@ -4965,7 +4965,7 @@ sub scan_autoconf_traces
# has a precise meaning for AC_CONFIG_FILES and so on.
$traces .= join (' ',
map { "--trace=$_" . ':\$f:\$l::\$d::\$n::\${::}%' }
- (keys %traced));
+ (sort keys %traced));
my $tracefh = new Automake::XFile ("$traces $filename |");
verb "reading $traces";
@@ -5486,7 +5486,7 @@ sub lang_vala_finish ()
{
my ($self) = @_;
- foreach my $prog (keys %known_programs)
+ foreach my $prog (sort keys %known_programs)
{
lang_vala_finish_target ($self, $prog);
}
diff --git a/contrib/tap-driver.pl b/contrib/tap-driver.pl
index 637c14c..72be689 100755
--- a/contrib/tap-driver.pl
+++ b/contrib/tap-driver.pl
@@ -198,14 +198,14 @@ TEST_RESULTS :
# Whether the test script should be re-run by "make recheck".
sub must_recheck ()
{
- return grep { !/^(?:XFAIL|PASS|SKIP)$/ } (keys %test_results_seen);
+ return grep { !/^(?:XFAIL|PASS|SKIP)$/ } (sort keys %test_results_seen);
}
# Whether the content of the log file associated to this test should
# be copied into the "global" test-suite.log.
sub copy_in_global_log ()
{
- return grep { not $_ eq "PASS" } (keys %test_results_seen);
+ return grep { not $_ eq "PASS" } (sort keys %test_results_seen);
}
sub get_global_test_result ()
diff --git a/doc/help2man b/doc/help2man
index e651b8d..d7ea539 100755
--- a/doc/help2man
+++ b/doc/help2man
@@ -204,7 +204,7 @@ while (@opt_include)
# Compress trailing blank lines.
for my $hash (\(%include, %append))
{
- for (keys %$hash) { $hash->{$_} =~ s/\n+$/\n/ }
+ for (sort keys %$hash) { $hash->{$_} =~ s/\n+$/\n/ }
}
sub get_option_value;
@@ -549,7 +549,7 @@ while (length)
# Check if matched paragraph contains /pat/.
if (%append)
{
- for my $pat (keys %append)
+ for my $pat (sort keys %append)
{
if ($matched =~ $pat)
{
diff --git a/lib/Automake/Channels.pm b/lib/Automake/Channels.pm
index a98fb51..d27ed01 100644
--- a/lib/Automake/Channels.pm
+++ b/lib/Automake/Channels.pm
@@ -290,7 +290,7 @@ sub _reset_duplicates (\%)
{
my ($ref) = @_;
my $dup = 0;
- foreach my $k (keys %$ref)
+ foreach my $k (keys %$ref) # sort keys not needed
{
$dup += $ref->{$k};
}
@@ -332,7 +332,7 @@ sub _merge_options (\%%)
my ($hash, %options) = @_;
local $_;
- foreach (keys %options)
+ foreach (sort keys %options)
{
if (exists $hash->{$_})
{
@@ -693,7 +693,7 @@ with those specified by C<%options>.
sub setup_channel_type ($%)
{
my ($type, %opts) = @_;
- foreach my $channel (keys %channels)
+ foreach my $channel (sort keys %channels)
{
setup_channel $channel, %opts
if $channels{$channel}{'type'} eq $type;
@@ -722,7 +722,7 @@ use vars qw (@_saved_channels @_saved_werrors);
sub dup_channel_setup ()
{
my %channels_copy;
- foreach my $k1 (keys %channels)
+ foreach my $k1 (keys %channels) # sort keys not needed
{
$channels_copy{$k1} = {%{$channels{$k1}}};
}
@@ -786,7 +786,7 @@ and the key to use for serialization.
sub setup_channel_queue ($$)
{
my ($queue, $key) = @_;
- foreach my $channel (keys %channels)
+ foreach my $channel (sort keys %channels)
{
setup_channel $channel, queue => $queue, queue_key => $key
if $channels{$channel}{'ordered'};
diff --git a/lib/Automake/Condition.pm b/lib/Automake/Condition.pm
index 7955f36..8ebf250 100644
--- a/lib/Automake/Condition.pm
+++ b/lib/Automake/Condition.pm
@@ -272,9 +272,9 @@ For instance C<$c3-E<gt>conds> will simply return C<("FALSE")>.
sub conds ($ )
{
my ($self) = @_;
- my @conds = keys %{$self->{'hash'}};
+ my @conds = sort keys %{$self->{'hash'}};
return ("TRUE") unless @conds;
- return sort @conds;
+ return @conds;
}
# Undocumented, shouldn't be needed outside of this class.
@@ -305,7 +305,7 @@ Return 1 iff this condition is always true.
sub true ($ )
{
my ($self) = @_;
- return 0 == keys %{$self->{'hash'}};
+ return 0 == keys %{$self->{'hash'}}; # sort not needed
}
=item C<$cond-E<gt>string>
diff --git a/lib/Automake/DisjConditions.pm b/lib/Automake/DisjConditions.pm
index 2f43391..11a35e9 100644
--- a/lib/Automake/DisjConditions.pm
+++ b/lib/Automake/DisjConditions.pm
@@ -248,7 +248,7 @@ otherwise.
sub false ($ )
{
my ($self) = @_;
- return 0 == keys %{$self->{'hash'}};
+ return 0 == keys %{$self->{'hash'}}; # sort keys not needed
}
=item C<$et = $set-E<gt>true>
diff --git a/lib/Automake/Getopt.pm b/lib/Automake/Getopt.pm
index 0f4d853..5e52344 100644
--- a/lib/Automake/Getopt.pm
+++ b/lib/Automake/Getopt.pm
@@ -62,7 +62,7 @@ sub parse_options (%)
if (@ARGV && $ARGV[0] =~ /^-./)
{
my %argopts;
- for my $k (keys %option)
+ for my $k (keys %option) # sort keys not needed
{
if ($k =~ /(.*)=s$/)
{
diff --git a/lib/Automake/Rule.pm b/lib/Automake/Rule.pm
index 58b2d4b..63ab4a1 100644
--- a/lib/Automake/Rule.pm
+++ b/lib/Automake/Rule.pm
@@ -429,7 +429,7 @@ sub register_suffix_rule ($$$)
# we know how to transform $src in that "something else".
if (exists $suffix_rules->{$dest})
{
- for my $dest2 (keys %{$suffix_rules->{$dest}})
+ for my $dest2 (sort keys %{$suffix_rules->{$dest}})
{
my $dist = $suffix_rules->{$dest}{$dest2}[1] + 1;
# Overwrite an existing $src->$dest2 path only if
@@ -444,8 +444,8 @@ sub register_suffix_rule ($$$)
# Similarly, any extension that can be derived into $src
# can be derived into the same extensions as $src can.
- my @dest2 = keys %{$suffix_rules->{$src}};
- for my $src2 (keys %$suffix_rules)
+ my @dest2 = sort keys %{$suffix_rules->{$src}};
+ for my $src2 (sort keys %$suffix_rules)
{
if (exists $suffix_rules->{$src2}{$src})
{
diff --git a/lib/gendocs.sh b/lib/gendocs.sh
index 198f646..fe172b6 100755
--- a/lib/gendocs.sh
+++ b/lib/gendocs.sh
@@ -237,8 +237,8 @@ BEGIN {
/<img src="(.*?)"/g && ++$need{$1};
END {
- #print "$me: @{[keys %need]}\n"; # for debugging, show images found.
- FILE: for my $f (keys %need) {
+ #print "$me: @{[sort keys %need]}\n"; # for debugging, show images found.
+ FILE: for my $f (sort keys %need) {
for my $d (@dirs) {
if (-f "$d/$f") {
use File::Basename;
diff --git a/lib/gitlog-to-changelog b/lib/gitlog-to-changelog
index e18b50b..df79065 100755
--- a/lib/gitlog-to-changelog
+++ b/lib/gitlog-to-changelog
@@ -417,7 +417,7 @@ sub git_dir_option($)
# Complain about any unused entry in the --amend=F specified file.
my $fail = 0;
- foreach my $sha (keys %$amend_code)
+ foreach my $sha (sort keys %$amend_code)
{
warn "$ME:$amend_file: unused entry: $sha\n";
$fail = 1;
