From 55179e46293c84d79109880bff204e8ee517683e Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 20 Jul 2019 14:12:11 -0600 Subject: [PATCH] Sort a bunch of outputs in dictionary order Makes them easier to read (cherry picked from commit 2d3877590e755fab8a115cd49bb99953dee5d516) Signed-off-by: Nicolas R --- dist/Devel-PPPort/PPPort_pm.PL | 12 ++++++++---- dist/Devel-PPPort/devel/mktodo.pl | 5 +++-- dist/Devel-PPPort/devel/scanprov | 3 ++- dist/Devel-PPPort/parts/inc/inctools | 28 ++++++++++++++++++++++++++++ dist/Devel-PPPort/parts/inc/ppphbin | 22 +++++++++++----------- 5 files changed, 52 insertions(+), 18 deletions(-) diff --git a/dist/Devel-PPPort/PPPort_pm.PL b/dist/Devel-PPPort/PPPort_pm.PL index d8ec65f..3ae7e8b 100644 --- a/dist/Devel-PPPort/PPPort_pm.PL +++ b/dist/Devel-PPPort/PPPort_pm.PL @@ -20,6 +20,7 @@ use strict; BEGIN { $^W = 1; } require "./parts/ppptools.pl"; +require "./parts/inc/inctools"; my $INCLUDE = 'parts/inc'; my $DPPP = 'DPPP_'; @@ -37,7 +38,7 @@ $data =~ s{^\%(include)\s+(\w+)((?:[^\S\r\n]+.*?)?)\s*$} $data = expand($data); -my @api = sort { lc $a cmp lc $b or $a cmp $b } keys %provides; +my @api = sort dictionary_order keys %provides; $data =~ s{^(.*)__PROVIDED_API__(\s*?)^} {join '', map "$1$_\n", @api}gem; @@ -54,7 +55,7 @@ $data =~ s!^(.*)__EXPLICIT_API__(\s*?)^! sprintf("$1$format\n", 'Function / Variable', 'Static Request', 'Global Request') . $1 . '-'x$len . "\n" . join('', map { sprintf "$1$format\n", $explicit{$_} eq 'var' ? $_ : "$_()", "NEED_$_", "NEED_${_}_GLOBAL" } - sort keys %explicit) + sort dictionary_order keys %explicit) !gem; } @@ -89,6 +90,7 @@ for (keys %provides) { } push @perl_api, keys %embed; +@perl_api = sort dictionary_order @perl_api; for (@perl_api) { if (exists $provides{$_} && !exists $raw_base{$_}) { @@ -109,7 +111,7 @@ for (@perl_api) { } $data =~ s/^([\t ]*)__PERL_API__(\s*?)$/ - join "\n", map "$1$_", sort @perl_api + join "\n", map "$1$_", sort dictionary_order @perl_api /gem; my $undocumented = "(undocumented)"; @@ -118,7 +120,7 @@ my @todo; for (reverse sort keys %todo) { my $ver = format_version($_); my $todo = "=item perl $ver\n\n"; - for (sort @{$todo{$_}}) { + for (sort dictionary_order @{$todo{$_}}) { $todo .= " $_"; $todo .= " (DEPRECATED)" if $embed{$_}->{flags}{D}; $todo .= " (marked experimental)" if $embed{$_}->{flags}{x}; @@ -641,6 +643,8 @@ SKIP %include ppphdoc { indent => '|>' } +%include inctools + %include ppphbin __DATA__ diff --git a/dist/Devel-PPPort/devel/mktodo.pl b/dist/Devel-PPPort/devel/mktodo.pl index c479eab..6d87ffd 100644 --- a/dist/Devel-PPPort/devel/mktodo.pl +++ b/dist/Devel-PPPort/devel/mktodo.pl @@ -276,7 +276,8 @@ sub write_todo $f = new IO::File ">$file" or die "cannot open $file: $!\n"; $f->print("$ver\n"); - for (sort keys %$sym) { + # Dictionary ordering, with only alphanumerics + for (sort dictionary_order keys %$sym) { $f->print(sprintf "%-30s # %s\n", $_, $sym->{$_}); } } @@ -337,7 +338,7 @@ sub get_apicheck_symbol_map @{$r->{stderr}}; if (keys %sym) { - for my $s (sort keys %sym) { + for my $s (sort dictionary_order keys %sym) { sym('new', $s, $sym{$s}); $all{$s} = $sym{$s}; } diff --git a/dist/Devel-PPPort/devel/scanprov b/dist/Devel-PPPort/devel/scanprov index 804524c..6a16700 100755 --- a/dist/Devel-PPPort/devel/scanprov +++ b/dist/Devel-PPPort/devel/scanprov @@ -18,6 +18,7 @@ use strict; use Getopt::Long; require './parts/ppptools.pl'; +require './parts/inc/inctools'; our %opt = ( mode => 'check', @@ -62,7 +63,7 @@ my $out = 'parts/base'; my $todo = parse_todo($out); for my $v (keys %v) { - my @new = sort grep { !exists $todo->{$_} } keys %{$v{$v}}; + my @new = sort dictionary_order grep { !exists $todo->{$_} } keys %{$v{$v}}; @new or next; my $file = $v; $file =~ s/\.//g; diff --git a/dist/Devel-PPPort/parts/inc/inctools b/dist/Devel-PPPort/parts/inc/inctools index df75aae..51e368a 100644 --- a/dist/Devel-PPPort/parts/inc/inctools +++ b/dist/Devel-PPPort/parts/inc/inctools @@ -55,4 +55,32 @@ sub parse_version return ($r, $v, $s); } +sub dictionary_order($$) # Sort caselessly, ignoring punct +{ + my ($lc_a, $lc_b); + my ($squeezed_a, $squeezed_b); + my ($valid_a, $valid_b); # Meaning valid for all releases + + # On early perls, the implicit pass by reference doesn't work, so we have + # to use the globals to initialize. + if ("$]" < "5.006" ) { + $valid_a = $a; $valid_b = $b; + } + else { + ($valid_a, $valid_b) = @_; + } + + $lc_a = lc $valid_a; + $lc_b = lc $valid_b; + + $squeezed_a = $lc_a; + $squeezed_a =~ s/[\W_]//g; # No punct, including no underscore + $squeezed_b = $lc_b; + $squeezed_b =~ s/[\W_]//g; + + return( $squeezed_a cmp $squeezed_b + or $lc_a cmp $lc_b + or $valid_a cmp $valid_b); +} + 1; diff --git a/dist/Devel-PPPort/parts/inc/ppphbin b/dist/Devel-PPPort/parts/inc/ppphbin index 1cf0236..bbf7b6f 100644 --- a/dist/Devel-PPPort/parts/inc/ppphbin +++ b/dist/Devel-PPPort/parts/inc/ppphbin @@ -90,7 +90,7 @@ __PERL_API__ if (exists $opt{'list-unsupported'}) { my $f; - for $f (sort { lc $a cmp lc $b } keys %API) { + for $f (sort dictionary_order keys %API) { next unless $API{$f}{todo}; print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n"; } @@ -176,14 +176,14 @@ while () { for (values %depends) { my %s; - $_ = [sort grep !$s{$_}++, @$_]; + $_ = [sort dictionary_order grep !$s{$_}++, @$_]; } if (exists $opt{'api-info'}) { my $f; my $count = 0; my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$"; - for $f (sort { lc $a cmp lc $b } keys %API) { + for $f (sort dictionary_order keys %API) { next unless $f =~ /$match/; print "\n=== $f ===\n\n"; my $info = 0; @@ -211,7 +211,7 @@ if (exists $opt{'api-info'}) { if (exists $opt{'list-provided'}) { my $f; - for $f (sort { lc $a cmp lc $b } keys %API) { + for $f (sort dictionary_order keys %API) { next unless $API{$f}{provided}; my @flags; push @flags, 'explicit' if exists $need{$f}; @@ -382,7 +382,7 @@ for $filename (@files) { my $c = $file{code}; my $warnings = 0; - for $func (sort keys %{$file{uses_Perl}}) { + for $func (sort dictionary_order keys %{$file{uses_Perl}}) { if ($API{$func}{varargs}) { unless ($API{$func}{nothxarg}) { my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))} @@ -400,12 +400,12 @@ for $filename (@files) { } } - for $func (sort keys %{$file{uses_replace}}) { + for $func (sort dictionary_order keys %{$file{uses_replace}}) { warning("Uses $func instead of $replace{$func}"); $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); } - for $func (sort keys %{$file{uses_provided}}) { + for $func (sort dictionary_order keys %{$file{uses_provided}}) { if ($file{uses}{$func}) { if (exists $file{uses_deps}{$func}) { diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}})); @@ -418,14 +418,14 @@ for $filename (@files) { } unless ($opt{quiet}) { - for $func (sort keys %{$file{uses_todo}}) { + for $func (sort dictionary_order keys %{$file{uses_todo}}) { print "*** WARNING: Uses $func, which may not be portable below perl ", format_version($API{$func}{todo}), ", even with '$ppport'\n"; $warnings++; } } - for $func (sort keys %{$file{needed_static}}) { + for $func (sort dictionary_order keys %{$file{needed_static}}) { my $message = ''; if (not exists $file{uses}{$func}) { $message = "No need to define NEED_$func if $func is never used"; @@ -439,7 +439,7 @@ for $filename (@files) { } } - for $func (sort keys %{$file{needed_global}}) { + for $func (sort dictionary_order keys %{$file{needed_global}}) { my $message = ''; if (not exists $global{uses}{$func}) { $message = "No need to define NEED_${func}_GLOBAL if $func is never used"; @@ -463,7 +463,7 @@ for $filename (@files) { if ($file{needs_inc_ppport}) { my $pp = ''; - for $func (sort keys %{$file{needs}}) { + for $func (sort dictionary_order keys %{$file{needs}}) { my $type = $file{needs}{$func}; next if $type eq 'extern'; my $suffix = $type eq 'global' ? '_GLOBAL' : ''; -- 1.8.3.1