util/combine_tests.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Best 0.05 [ [qw/YAML::Syck YAML/], qw/Dump LoadFile/ ];
   7 #my @data = map { YAML::LoadFile($_) } @ARGV;
   8 #
   9 #my $combined = combine_tests(@data);
  10 #
  11 #print YAML::Dump($combined);
  12 print Dump(combine_tests(map { LoadFile($_) } @ARGV));
  13 #
  14 # Annotates the last test tree with the earlier one's
  15 # and returns the modified reference.
  16 # Note: no copy is made!
  17 #
  18 # Adds a more_events[] with events to each event for which
  19 # there are variations among the tests.
  20 # A revision is added to each member of the more_events[].
  21 #
  22 # more_revisions[] is added with revision number of the older versions.
  23 #
  24 sub combine_tests{
  25     #
  26     # Collect all the test results indexed on filename/number
  27     # into %sum
  28     #
  29     my %sum;
  30     my @revisions;
  31     for my $data (@_) {
  32         my $revision = $data->{revision};
  33         push @revisions, $revision;
  34         for my $file (@{ $data->{meat}{test_files} }) {
  35             my $fname = $file->{file};
  36             for my $event (@{ $file->{events} }) {
  37                 my $n = $event->{num};
  38                 push @{ $sum{$fname}[$n] }, {%$event, revision => $revision };
  39             }
  40         }
  41     }
  42
  43     #
  44     # Remove all events which are *identical*
  45     #
  46     my $all_the_same = sub {
  47         my $first = shift;
  48         for my $o ( @_ ) {
  49             for my $k ( keys %$o ) {
  50                 next if $k eq 'revision';
  51                 return 0 unless defined $o->{$k};
  52                 return 0 unless $first->{$k} eq $o->{$k};
  53             }
  54         }
  55         return 1;
  56     };
  57
  58     while( my ($fname, $events) =  each %sum ) {
  59         for(my $i=1; $i<@$events; $i++) {
  60             my $event = $events->[$i];
  61             if($all_the_same->(@{ $events->[$i] })) {
  62                 undef $events->[$i];
  63             } else {
  64                 pop @{ $events->[$i] };
  65             }
  66         }
  67     }
  68
  69     #
  70     # Now, walk the target tree and add anomalies
  71     # to each event.
  72     # Note that I use the test number for reference, which will
  73     # blow up in our faces when tests are inserted.
  74     # It is better then checking for the names of the tests
  75     # since they are often the same for different tests.
  76     #
  77     my $target = $_[-1];
  78     for my $file (@{ $target->{meat}{test_files} }) {
  79         my $fname = $file->{file};
  80         for my $event (@{ $file->{events} }) {
  81             my $n = $event->{num};
  82             if( defined $sum{$fname}[$n]){
  83                 $event->{more_events} = $sum{$fname}[$n];
  84             }
  85         }
  86     }
  87
  88     #
  89     # Add revisions which were added, not the target though
  90     #
  91     pop @revisions;
  92     $target->{more_revisions} = [ @revisions ] if @revisions;
  93     $target;
  94 }