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 6package Subunit::Diff; 7 8use strict; 9 10use Subunit qw(parse_results); 11 12sub control_msg() { } 13sub report_time($$) { } 14 15sub output_msg($$) 16{ 17 my ($self, $msg) = @_; 18 19 # No output for now, perhaps later diff this as well ? 20} 21 22sub start_test($$) 23{ 24 my ($self, $testname) = @_; 25} 26 27sub end_test($$$$$) 28{ 29 my ($self, $testname, $result, $unexpected, $reason) = @_; 30 31 $self->{$testname} = $result; 32} 33 34sub skip_testsuite($;$) { } 35sub start_testsuite($;$) { } 36sub end_testsuite($$;$) { } 37sub testsuite_count($$) { } 38 39sub new { 40 my ($class) = @_; 41 42 my $self = { 43 }; 44 bless($self, $class); 45} 46 47sub 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 66sub 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 801; 81