BrowserUnitTests.pm 5.62 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
13
14

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

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

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

sub pre_tests {
    my ($tbbinfos) = @_;
    chdir $tbbinfos->{browserdir};
boklm's avatar
boklm committed
47
48
    system('git', 'clean', '-fxd');
    system('git', 'reset', '--hard');
boklm's avatar
boklm committed
49
50
51
52
53
54
55
56
57
58
59
60
61
62
    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
63
64
65
66
67
}

sub post_tests {
}

68
69
70
71
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
128
129
130
131
132
133
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 {
    my ($report, $tbbfile) = @_;
    my $tbbinfos = $report->{tbbfiles}{$tbbfile};
    return unless $tbbinfos->{parent_results};
    my $r = TBBTestSuite::Reports::load_report($tbbinfos->{parent_results}[0]);
    return unless $r;
    my $parent = $r->{tbbfiles}{$tbbinfos->{parent_results}[1]};
    return unless $parent;
    $tbbinfos->{parent_diff} = diff_results($parent, $tbbinfos);
}

boklm's avatar
boklm committed
134
135
136
137
138
139
140
141
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
142
        $dir =~ s{/$}{};
boklm's avatar
boklm committed
143
144
145
146
147
        return if $dir =~ m/^obj-/;
        push @res, {
            name  => "xpcshell:$dir",
            type  => 'xpcshell',
            descr => "xpcshell test in directory $dir",
boklm's avatar
boklm committed
148
            dir   => $dir,
boklm's avatar
boklm committed
149
150
151
152
153
154
155
156
157
        };
    };
    find($wanted, $tbbinfos->{browserdir});
    return @res;
}

sub xpcshell_test {
    my ($tbbinfos, $test) = @_;
    my ($out, $err, $success) =
boklm's avatar
boklm committed
158
                capture_exec('./mach', 'xpcshell-test', $test->{dir});
boklm's avatar
boklm committed
159
160
161
162
163
164
165
166
167
168
169
    $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
170
171
sub build_firefox {
    my ($tbbinfos, $test) = @_;
172
    my $nbcpu = get_nbcpu;
boklm's avatar
boklm committed
173
174
    $test->{results}{success} = 0;
    copy("$FindBin::Bin/data/mozconfig", '.mozconfig');
175
176
177
178
179
    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
180
181
182
    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",
183
        'make', "-j$nbcpu", '-f', 'client.mk', 'build') or return;
boklm's avatar
boklm committed
184
185
186
    $test->{results}{success} = 1;
}

boklm's avatar
boklm committed
187
1;