Tests.pm 6.41 KB
Newer Older
boklm's avatar
boklm committed
1
2
3
4
package TBBTestSuite::Tests;

use warnings;
use strict;
boklm's avatar
boklm committed
5
use English;
boklm's avatar
boklm committed
6
7
8
9
10
11
use FindBin;
use Cwd qw(getcwd);
use File::Spec;
use File::Temp;
use File::Slurp;
use LWP::UserAgent;
12
use TBBTestSuite::Reports;
13
use TBBTestSuite::Common qw(exit_error);
boklm's avatar
boklm committed
14
use TBBTestSuite::Options qw($options);
15
use TBBTestSuite::BrowserBundleTests qw(tbb_filename_infos);
16
use TBBTestSuite::BrowserUnitTests;
boklm's avatar
boklm committed
17
use TBBTestSuite::XServer qw(set_Xmode);
18

19
our %testsuite_types = (
20
21
22
    browserunit => \%TBBTestSuite::BrowserUnitTests::testsuite,
    browserbundle => \%TBBTestSuite::BrowserBundleTests::testsuite,
);
boklm's avatar
boklm committed
23

boklm's avatar
boklm committed
24
25
sub run_tests {
    my ($tbbinfos) = @_;
26
27
28
29
30
31
    my @enable_tests;
    if ($options->{'enable-tests'}) {
        @enable_tests = ref $options->{'enable-tests'} ?
                            @{$options->{'enable-tests'}}
                            : split(',', $options->{'enable-tests'});
    }
boklm's avatar
boklm committed
32
33
34
35
36
37
    my @disable_tests;
    if ($options->{'disable-tests'}) {
        @disable_tests = ref $options->{'disable-tests'} ?
                            @{$options->{'disable-tests'}}
                            : split(',', $options->{'disable-tests'});
    }
38
    my $test_types = $testsuite_types{$tbbinfos->{type}}->{test_types};
39
40
41
    foreach my $test (@{$tbbinfos->{tests}}) {
        $test->{fail_type} //= 'error';
    }
42
    foreach my $test (@{$tbbinfos->{tests}}) {
43
        if (@enable_tests && ! grep { $test->{name} eq $_ } @enable_tests) {
boklm's avatar
boklm committed
44
45
            next;
        }
boklm's avatar
boklm committed
46
47
48
        if (@disable_tests && grep { $test->{name} eq $_ } @disable_tests) {
            next;
        }
49
50
51
        if ($test->{enable} && !$test->{enable}->($tbbinfos, $test)) {
            next;
        }
52
53
54
        print "\n", '*' x (17 + length($test->{name})), "\n";
        print "* Running test $test->{name} *\n";
        print '*' x (17 + length($test->{name})), "\n\n";
boklm's avatar
boklm committed
55
        $test->{start_time} = time;
boklm's avatar
boklm committed
56
57
58
        if ($options->{xdummy} && $test->{resolution}) {
            set_Xmode($tbbinfos->{Xdisplay}, $test->{resolution});
        }
59
        $test->{pre}->($tbbinfos, $test) if $test->{pre};
boklm's avatar
boklm committed
60
61
        $test_types->{$test->{type}}->($tbbinfos, $test)
                if $test_types->{$test->{type}};
62
        $test->{post}->($tbbinfos, $test) if $test->{post};
boklm's avatar
boklm committed
63
64
65
        if ($options->{xdummy} && $test->{resolution}) {
            set_Xmode($tbbinfos->{Xdisplay}, $options->{resolution});
        }
boklm's avatar
boklm committed
66
67
        $test->{finish_time} = time;
        $test->{run_time} = $test->{finish_time} - $test->{start_time};
68
        if ($test->{fail_type} eq 'fatal' && is_test_error($test)) {
boklm's avatar
boklm committed
69
70
            last;
        }
boklm's avatar
boklm committed
71
72
73
    }
}

boklm's avatar
boklm committed
74
75
sub is_test_error {
    my ($test) = @_;
boklm's avatar
boklm committed
76
77
78
    if ($test->{fail_type} ne 'fatal' && $test->{fail_type} ne 'error') {
        return 0;
    }
boklm's avatar
boklm committed
79
80
81
    return $test->{results} && !$test->{results}{success};
}

boklm's avatar
boklm committed
82
83
84
85
86
87
sub is_test_warning {
    my ($test) = @_;
    return $test->{results} && $test->{fail_type} eq 'warning'
           && !$test->{results}{success};
}

88
89
90
91
92
93
sub is_test_known {
    my ($test) = @_;
    return $test->{results} && $test->{fail_type} eq 'known'
           && !$test->{results}{success};
}

boklm's avatar
boklm committed
94
95
sub is_success {
    my ($tests) = @_;
96
    foreach my $test (@$tests) {
boklm's avatar
boklm committed
97
        return 0 if is_test_error($test);
boklm's avatar
boklm committed
98
99
100
101
    }
    return 1;
}

102
103
104
105
106
107
108
109
110
111
112
113
114
sub check_known_issues {
    my ($tbbinfos) = @_;
    return unless $options->{known_issues};
    foreach my $test (@{$tbbinfos->{tests}}) {
        next unless $test->{results};
        next if $test->{results}{success};
        my $issue = $options->{known_issues}{$test->{name}};
        next unless $issue;
        $issue = $issue->($tbbinfos, $test) if ref $issue eq 'CODE';
        @{$test}{keys %$issue} = values %$issue;
    }
}

boklm's avatar
boklm committed
115
116
117
118
119
120
121
122
sub test_by_name {
    my ($tests, $name) = @_;
    foreach my $test (@$tests) {
        return $test if $test->{name} eq $name;
    }
    return undef;
}

boklm's avatar
boklm committed
123
124
sub matching_tbbfile {
    my $o = tbb_filename_infos($_[0]);
boklm's avatar
boklm committed
125
    return $o->{type} eq 'browserbundle' && $o->{os} eq $options->{os}
boklm's avatar
boklm committed
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
        && $o->{arch} eq $options->{arch};
}

sub check_gpgsig {
    my ($file) = @_;
    my $keyring = $options->{keyring} =~ m/^\// ? $options->{keyring}
        : "$FindBin::Bin/keyring/$options->{keyring}";
    return system('gpg', '--no-default-keyring', '--keyring', $keyring,
        '--verify', '--', $file) == 0;
}

sub test_sha {
    my ($report, $shafile) = @_;
    my $content;
    if ($shafile =~ m/^https?:\/\//) {
        my $ua = LWP::UserAgent->new;
        my $resp = $ua->get($shafile);
        exit_error "Error downloading $shafile:\n" . $resp->status_line
                unless $resp->is_success;
        $content = $resp->decoded_content;
        if ($options->{gpgcheck}) {
            $resp = $ua->get("$shafile.asc");
            exit_error "Error downloading $shafile.asc:\n" . $resp->status_line
                unless $resp->is_success;
150
            my $tmpdir = File::Temp::newdir('XXXXXX', DIR => $options->{tmpdir});
boklm's avatar
boklm committed
151
152
153
154
155
156
157
158
159
160
161
162
            write_file("$tmpdir/sha256sum.txt", $content);
            write_file("$tmpdir/sha256sum.txt.asc", $resp->decoded_content);
            exit_error "Error checking gpg signature of $shafile"
                unless check_gpgsig("$tmpdir/sha256sum.txt.asc");
        }
    } else {
        $content = read_file($shafile);
    }
    my (undef, $dir) = File::Spec->splitpath($shafile);
    my @files = map { [ reverse split /  /, $_ ] } split /\n/, $content;
    @files = grep { matching_tbbfile($_->[0]) } @files;
    foreach my $file (@files) {
163
164
        my $tbbinfos = tbb_filename_infos("$dir/$file->[0]");
        $tbbinfos->{sha256sum} = $file->[1];
boklm's avatar
boklm committed
165
        test_start($report, $tbbinfos);
boklm's avatar
boklm committed
166
167
168
    }
}

boklm's avatar
boklm committed
169
sub test_start {
170
    my ($report, $tbbinfos) = @_;
boklm's avatar
boklm committed
171
    my $oldcwd = getcwd;
172
    my $tmpdir = File::Temp::newdir('XXXXXX', DIR => $options->{tmpdir});
boklm's avatar
boklm committed
173
    $tbbinfos->{tmpdir} = $tmpdir->dirname;
174
    $tbbinfos->{tests} //= [ map { { %$_ } } @TBBTestSuite::BrowserBundleTests::tests ];
boklm's avatar
boklm committed
175
    $tbbinfos->{'results-dir'} =
176
177
        TBBTestSuite::Reports::report_path($report,
                                        "results-$tbbinfos->{filename}");
boklm's avatar
boklm committed
178
    mkdir $tbbinfos->{'results-dir'};
179
180
    my $testsuite = $testsuite_types{$tbbinfos->{type}};
    $testsuite->{pre_tests}($tbbinfos);
boklm's avatar
boklm committed
181
    $tbbinfos->{start_time} = time;
boklm's avatar
boklm committed
182
    run_tests($tbbinfos);
boklm's avatar
boklm committed
183
184
    $tbbinfos->{finish_time} = time;
    $tbbinfos->{run_time} = $tbbinfos->{finish_time} - $tbbinfos->{start_time};
185
    $testsuite->{post_tests}($tbbinfos);
boklm's avatar
boklm committed
186
    chdir $oldcwd;
187
    check_known_issues($tbbinfos);
boklm's avatar
boklm committed
188
189
190
191
192
    $tbbinfos->{success} = is_success($tbbinfos->{tests});
    $report->{tbbfiles}{$tbbinfos->{filename}} = $tbbinfos;
}

1;