BrowserUnitTests.pm 6.16 KB
Newer Older
boklm's avatar
boklm committed
1
2
3
package TBBTestSuite::BrowserUnitTests;

use strict;
boklm's avatar
boklm committed
4
use FindBin;
boklm's avatar
boklm committed
5
6
7
use IO::CaptureOutput qw(capture_exec);
use File::Spec;
use File::Find;
boklm's avatar
boklm committed
8
use File::Copy;
9
use File::Slurp;
boklm's avatar
boklm committed
10
use TBBTestSuite::Common qw(exit_error get_nbcpu run_to_file);
11
use TBBTestSuite::Reports qw(load_report);
boklm's avatar
boklm committed
12
use TBBTestSuite::Options qw($options);
boklm's avatar
boklm committed
13
14
15

my $test_types = {
    xpcshell => \&xpcshell_test,
boklm's avatar
boklm committed
16
    build_firefox => \&build_firefox,
boklm's avatar
boklm committed
17
18
};

19
20
21
22
our %testsuite = (
    test_types => $test_types,
    pre_tests  => \&pre_tests,
    post_tests => \&post_tests,
23
    pre_makereport => \&pre_makereport,
24
    pre_reports_index => \&pre_reports_index,
25
26
);

boklm's avatar
boklm committed
27
28
29
30
sub get_tbbinfos {
    my ($infos) = @_;
    my %tbbinfos = (
        %$infos,
31
        type => 'browserunit',
boklm's avatar
boklm committed
32
        filename => "browser-$infos->{commit}",
boklm's avatar
boklm committed
33
34
35
36
37
38
39
40
        tests => [
            {
                name => 'build_firefox',
                type => 'build_firefox',
                fail_type => 'fatal',
                descr => 'Build Firefox',
            },
        ],
boklm's avatar
boklm committed
41
42
43
44
45
46
47
48
    );
    push @{$tbbinfos{tests}}, find_xpcshell_tests(\%tbbinfos);
    return \%tbbinfos;
}

sub pre_tests {
    my ($tbbinfos) = @_;
    chdir $tbbinfos->{browserdir};
boklm's avatar
boklm committed
49
50
51
52
    if ($options->{clean_browserdir}) {
        system('git', 'clean', '-fxd');
        system('git', 'reset', '--hard');
    }
boklm's avatar
boklm committed
53
54
55
56
57
58
59
60
61
62
63
64
65
66
    system('git', 'checkout', $tbbinfos->{commit}) == 0
        or exit_error "Error checking out $tbbinfos->{commit}";
    my ($out, $err, $success) = capture_exec('git', 'show', '-s',
        '--abbrev=20', '--format=%p', $tbbinfos->{commit});
    exit_error "Error checking parents of $tbbinfos->{commit}" unless $success;
    $tbbinfos->{parent_commits} = [ split(' ', $out) ];
    ($out, $err, $success) = capture_exec('git', 'show', '-s',
        '--format=%s', $tbbinfos->{commit});
    exit_error "Error getting commit subject" unless $success;
    $tbbinfos->{commit_subject} = $out;
    ($out, $err, $success) = capture_exec('git', 'show', '-s',
        '--format=%an', $tbbinfos->{commit});
    exit_error "Error getting commit author" unless $success;
    $tbbinfos->{commit_author} = $out;
boklm's avatar
boklm committed
67
68
69
70
71
}

sub post_tests {
}

72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
sub tests_by_name {
    my ($tests) = @_;
    my %res = map { $_->{name} => $_ } @$tests;
    return \%res;
}

sub xpcshell_subtests_diff {
    my ($t1, $t2) = @_;
    my (@fail, @fixed);
    my %f1 = map { $_ => 1 } @{$t1->{results}{failed}};
    my %f2 = map { $_ => 1 } @{$t2->{results}{failed}};
    my %f = ( %f1, %f2);
    foreach my $t (keys %f) {
        if ($f2{$t} && !$f1{$t}) {
            push @fail, $t;
        }
        if (!$f2{$t} && $f1{$t}) {
            push @fixed, $t;
        }
    }
    if (@fail or @fixed) {
        return { fail => \@fail, fixed => \@fixed };
    }
    return undef;
}

sub diff_results {
    my ($r1, $r2) = @_;
    my %res;
    $res{run_time} = $r2->{run_time} - $r1->{run_time};
    $res{fail_tests} = [];
    $res{fixed_tests} = [];
    $res{tests_time} = {};
    $res{subtests} = {};
    my $r1t = tests_by_name($r1->{tests});
    my $r2t = tests_by_name($r2->{tests});
    foreach my $test (keys %$r2t) {
        my ($t1, $t2) = ($r1t->{$test}, $r2t->{$test});
        $res{tests_time}->{$test} = $t2->{run_time} - $t1->{run_time};
        next unless defined $t1->{results};
        next unless defined $t2->{results};
        if (!$t2->{results}{success} && $t1->{results}{success}) {
            push @{$res{fail_tests}}, $test;
        }
        if ($t2->{results}{success} && !$t1->{results}{success}) {
            push @{$res{fixed_tests}}, $test;
        }
        if ($t1->{type} eq 'xpcshell') {
            my $s = xpcshell_subtests_diff($t1, $t2);
            $res{subtests}{$test} = $s if $s;
        }
    }
    return \%res;
}

sub pre_makereport {
128
    my ($report, $tbbfile, $r) = @_;
129
130
    my $tbbinfos = $report->{tbbfiles}{$tbbfile};
    return unless $tbbinfos->{parent_results};
131
    $r //= TBBTestSuite::Reports::load_report($tbbinfos->{parent_results}[0]);
132
133
134
135
136
137
    return unless $r;
    my $parent = $r->{tbbfiles}{$tbbinfos->{parent_results}[1]};
    return unless $parent;
    $tbbinfos->{parent_diff} = diff_results($parent, $tbbinfos);
}

138
139
140
141
142
143
144
145
146
147
sub pre_reports_index {
    my ($reports, $report) = @_;
    foreach my $tbbfile (keys %{$report->{tbbfiles}}) {
        my $tbbinfos = $report->{tbbfiles}{$tbbfile};
        pre_makereport($report, $tbbfile,
                       $reports->{$tbbinfos->{parent_results}[0]})
                   if $tbbinfos->{parent_results};
    }
}

boklm's avatar
boklm committed
148
149
150
151
152
153
154
155
sub find_xpcshell_tests {
    my ($tbbinfos) = @_;
    my @res;
    my $wanted = sub {
        return unless -f $File::Find::name;
        my (undef, $dir, $file) = File::Spec->splitpath($File::Find::name);
        return unless $file eq 'xpcshell.ini';
        $dir =~ s{^$tbbinfos->{browserdir}/}{};
boklm's avatar
boklm committed
156
        $dir =~ s{/$}{};
boklm's avatar
boklm committed
157
158
159
160
161
        return if $dir =~ m/^obj-/;
        push @res, {
            name  => "xpcshell:$dir",
            type  => 'xpcshell',
            descr => "xpcshell test in directory $dir",
boklm's avatar
boklm committed
162
            dir   => $dir,
boklm's avatar
boklm committed
163
164
165
166
167
168
169
170
171
        };
    };
    find($wanted, $tbbinfos->{browserdir});
    return @res;
}

sub xpcshell_test {
    my ($tbbinfos, $test) = @_;
    my ($out, $err, $success) =
boklm's avatar
boklm committed
172
173
                capture_exec('xvfb-run', '--server-args=-screen 0 1024x768x24',
                    './mach', 'xpcshell-test', $test->{dir});
boklm's avatar
boklm committed
174
175
176
177
178
179
180
181
182
183
184
    $test->{results}{success} = $success;
    $test->{results}{out} = $out;
    $test->{results}{failed} = [];
    foreach my $line (split "\n", $out) {
        if ($line =~ m{TEST-UNEXPECTED-FAIL \| /([^\|]+) \|}) {
            my (undef, undef, $file) = File::Spec->splitpath($1);
            push @{$test->{results}{failed}}, $file;
        }
    }
}

boklm's avatar
boklm committed
185
186
sub build_firefox {
    my ($tbbinfos, $test) = @_;
187
    my $nbcpu = get_nbcpu;
boklm's avatar
boklm committed
188
189
    $test->{results}{success} = 0;
    copy("$FindBin::Bin/data/mozconfig", '.mozconfig');
190
191
192
193
194
    my @l = read_file('.mozconfig');
    foreach (@l) {
        s/MOZ_MAKE_FLAGS="-j4"/MOZ_MAKE_FLAGS="-j$nbcpu"/;
    }
    write_file('.mozconfig', @l);
boklm's avatar
boklm committed
195
196
197
    run_to_file("$tbbinfos->{'results-dir'}/$test->{name}.configure.txt",
        'make', '-f', 'client.mk', 'configure') or return;
    run_to_file("$tbbinfos->{'results-dir'}/$test->{name}.build.txt",
198
        'make', "-j$nbcpu", '-f', 'client.mk', 'build') or return;
boklm's avatar
boklm committed
199
200
201
    $test->{results}{success} = 1;
}

boklm's avatar
boklm committed
202
1;