selftest/Subunit/Diff.pm

   1 #!/usr/bin/perl
   2 # Diff two subunit streams
   3 # Copyright (C) Jelmer Vernooij <jelmer@samba.org>
   4 # Published under the GNU GPL, v3 or later
   5
   6 package Subunit::Diff;
   7
   8 use strict;
   9
  10 use Subunit qw(parse_results);
  11
  12 sub control_msg() { }
  13 sub report_time($$) { }
  14
  15 sub output_msg($$)
  16 {
  17         my ($self, $msg) = @_;
  18
  19         # No output for now, perhaps later diff this as well ?
  20 }
  21
  22 sub start_test($$)
  23 {
  24         my ($self, $testname) = @_;
  25 }
  26
  27 sub end_test($$$$$)
  28 {
  29         my ($self, $testname, $result, $unexpected, $reason) = @_;
  30
  31         $self->{$testname} = $result;
  32 }
  33
  34 sub skip_testsuite($;$) { }
  35 sub start_testsuite($;$) { }
  36 sub end_testsuite($$;$) { }
  37 sub testsuite_count($$) { }
  38
  39 sub new {
  40         my ($class) = @_;
  41
  42         my $self = {
  43         };
  44         bless($self, $class);
  45 }
  46
  47 sub from_file($)
  48 {
  49         my ($path) = @_;
  50         my $statistics = {
  51                 TESTS_UNEXPECTED_OK => 0,
  52                 TESTS_EXPECTED_OK => 0,
  53                 TESTS_UNEXPECTED_FAIL => 0,
  54                 TESTS_EXPECTED_FAIL => 0,
  55                 TESTS_ERROR => 0,
  56                 TESTS_SKIP => 0,
  57         };
  58
  59         my $ret = new Subunit::Diff();
  60         open(IN, $path) or return;
  61         parse_results($ret, $statistics, *IN);
  62         close(IN);
  63         return $ret;
  64 }
  65
  66 sub diff($$)
  67 {
  68         my ($old, $new) = @_;
  69         my $ret = {};
  70
  71         foreach my $testname (keys %$old) {
  72                 if ($new->{$testname} ne $old->{$testname}) {
  73                         $ret->{$testname} = [$old->{$testname}, $new->{$testname}];
  74                 }
  75         }
  76
  77         return $ret;
  78 }
  79
  80 1;