Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

status_upd: improve logic, auto-install Data::Dumper,Set::Object via …

…cpan

bail out earlier if one of the results is empty,
do not fill skipped $h entries
  • Loading branch information...
commit 1d5d8f92128b2aeeb38b063f53ef1dde98b4a05f 1 parent afb8b8c
@rurban authored
Showing with 26 additions and 11 deletions.
  1. +26 −11 status_upd
View
37 status_upd
@@ -1,13 +1,25 @@
#!/usr/bin/perl -w
-# status_upd [-suqftad] [ 1.26 | path ]
+# status_upd [-suqftad] [ 1.32 | path ]
# process perlall maketest logfiles:
# `perl$ver Makefile.PL && make test > log.test-$platform-$ver; make clean`
-# and find and sort by FAIL/TODO and platform+version
+# and find, sort by FAIL/TODO and platform+version
use strict;
-use Data::Dumper;
use Getopt::Long;
-use Set::Object qw(reftype);
+
+BEGIN {
+ sub _auto_use { # autoinstall the non-core modules, and use them
+ my @m;
+ for (@_) { push @m, $_ unless eval "require $_;" }
+ if (@m) { # Checked the API back to 1.76_01 (v5.8.4)
+ require CPAN; CPAN->import;
+ warn "CPAN::Shell->install(qw(@m))\n"; CPAN::Shell->install(@m); }
+ #$_->import for @m;
+ }
+ _auto_use qw(Data::Dumper Set::Object);
+ Set::Object->import('reftype');
+ Data::Dumper->import;
+}
sub help {
print <<EOF;
@@ -110,8 +122,8 @@ sub status {
my $c = "$file\t" if $failed;
$c .= "\t" if length($file) < 8;
$c .= "$failed\n";
- $h{$prefix}->{$file} = $f;
next if $skipped;
+ $h{$prefix}->{$file} = $f;
print "$c" unless $quiet;
$s .= $c;
}
@@ -123,8 +135,8 @@ sub status {
# debian-squeeze-amd64-5.10.1-nt => ("debian-squeeze-amd64", "5.10", "nt")
sub platform_version_split {
local $_ = shift;
- my ($p,$v,$f) = m/^(.+)-(5\.[\d\.]+)([-dnt]+)?$/;
- $f =~ s/^-// if $f; # d, d-nt, nt or empty
+ my ($p,$v,$f) = m/^(.+)-(5\.[\d\.]+)([-dntm]+)?$/;
+ $f =~ s/^-// if $f; # d, d-nt, nt, m or empty
$v =~ s/(\d\.\d+)\.\d+/$1/ if $v;
return ($p,$v,$f);
}
@@ -157,13 +169,16 @@ sub all_common {
my $h = shift; # platform_version -> test_file -> test_no_failed
my $result = shift; # skip already deleted results, initially empty
my (%tests);
- if (@_ == 1) {
+ if (@_ == 1) { # shortcut: only one feature
delete $h->{$_[0]}->{''};
return $h->{$_[0]};
}
# init with shortest list, sort hash by least number of keys
my @p = sort { h_size($h->{$a}) <=> h_size($h->{$b}) } @_;
my $pivot = $p[0];
+ if (keys %{$h->{$pivot}} == 1 and exists $h->{$pivot}->{''}) { # shortcut: empty result
+ return {};
+ }
my $pivotset = Set::Object->new(keys %{$h->{$pivot}});
for ($pivotset->members) {
if (my $k = $h->{$pivot}->{$_}) {
@@ -177,7 +192,7 @@ sub all_common {
$result->{$_} = $result->{$_} ? $tests{$_} * $result->{$_} : $tests{$_};
$result->{$_} = $result->{$_} * Set::Object->new( split_tests($h->{$p}->{$_}) )
if $result->{$_}->members;
- $result->{$_} = $result->{$_}->members;# status_upd -f -q -d
+ $result->{$_} = $result->{$_}->members;# status_upd -fqd
}
delete $result->{$_} unless $result->{$_};
}
@@ -223,7 +238,7 @@ sub unify_results {
push @{$versions{$v}}, ($_) if $v;
}
for my $v (sort keys %versions) {
- if ($v !~ /^5\.(7|9|11)$/) { # skip 5.11, 5.9, 5.7, but not blead (5.13 currently)
+ if ($v !~ /^5\.(7|9|11|13)$/) { # skip 5.11, 5.9, 5.7, but not blead (5.15 currently)
my $v1 = all_common($h, $result, @{$versions{$v}});
if (%$v1) {
print Data::Dumper->Dump([$v1],["v$v $name"]);
@@ -247,7 +262,7 @@ sub unify_results {
}
}
-my $dlogs = '`ls '.($dir eq '.'?$logs:"$dir/$logs").'|egrep -v \'\.[1-9]$\'`';
+my $dlogs = '`ls '.($dir eq '.'?$logs:"$dir/$logs").'|egrep -v \'\.[1-9]+$\'`';
#warn $dlogs."\n" unless $quiet; #`
my $cmd = 'grep -a -i "tests" ' . $dlogs . " | grep -v t/CORE";
warn "$cmd\n" unless $quiet;
Please sign in to comment.
Something went wrong with that request. Please try again.