1
# LSB Test Execution Framework
2
# Desktop Test Module (Desktop_test.pm)
4
# Copyright (C) 2007-2009 The Linux Foundation. All rights reserved.
6
# This program has been developed by ISP RAS for LF.
7
# The ptyshell tool is originally written by Jiri Dluhos <jdluhos@suse.cz>
8
# Copyright (C) 2005-2007 SuSE Linux Products GmbH
10
# This program is free software; you can redistribute it and/or
11
# modify it under the terms of the GNU General Public License
12
# version 2 as published by the Free Software Foundation.
14
# This program is distributed in the hope that it will be useful,
15
# but WITHOUT ANY WARRANTY; without even the implied warranty of
16
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17
# GNU General Public License for more details.
19
# You should have received a copy of the GNU General Public License
20
# along with this program; if not, write to the Free Software
21
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
22
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
31
our @ISA = qw(Test_common); # Inherit Test_common
34
#----------------------------------------------------------------------
36
my $short_scenario = 0; # DBG: TODO: remove all short scen?
41
"fontconfig" => "FONTCONFIG",
45
"freetype" => "FREETYPE",
46
"xrender" => "XRENDER",
51
#----------------------------------------------------------------------
56
if ( version_filter("LSB <= 3.1", $globals->{'standard'}) ) {
57
# For LSB 3.1 and older releases
59
does_shell_know ("Xvfb")
60
or return error "Can't find the 'Xvfb' tool required by "
61
.$self->name." test.";
62
# TODO: suggest to install this tool, refer to help.
65
is_ok $self->prepare_options() or return $Error::Last;
73
( defined $self->{OPTIONS} )
74
or return error "Answers are undefined"; # Should not happen
76
my $testsuite_dir = $self->option('TESTSUITE_DIR') || "/opt/lsb/test/desktop";
77
$self->{TESTSUITE_DIR} = $testsuite_dir;
81
if ( defined $self->{OPTIONS}{$q} ) {
82
if ( !defined $self->{OPTIONS}{$q}->{VALUE} ) {
83
my $x11_fonts_dir = X11_common::guess_font_dir();
84
is_ok($x11_fonts_dir) or return error $self->name
85
." test requires certain X11 fonts to be installed.", $Error::Last;
86
$self->{OPTIONS}{$q}->{VALUE} = $x11_fonts_dir."/misc";
91
if ( defined $self->{OPTIONS}{$q} ) {
92
if ( !defined $self->{OPTIONS}{$q}->{VALUE} ) {
93
$self->{OPTIONS}{$q}->{VALUE} = X11_common::guess_display();
97
$q = 'DESKTOP_ENVIRONMENT';
98
if ( defined $self->{OPTIONS}{$q} ) {
99
if ( !defined $self->{OPTIONS}{$q}->{VALUE} ) {
100
$self->{OPTIONS}{$q}->{VALUE} = X11_common::guess_DE();
104
if ( $globals->{'cert_mode'} && version_filter("LSB >= 3.2", $globals->{'standard'}) ) {
105
$self->{OPTIONS}{'with_qt4'}->{VALUE} = "desktop_qt4";
114
# Call the parent's prepare function
115
is_ok $self->Test_common::prepare() or return $Error::Last;
117
# Download and install required packages
118
is_ok $self->prepare_test_packages() # According to the Manifest
119
or return error "Failed to download and install packages for '"
120
.$self->name."' test.", $Error::Last;
122
is_ok $self->prepare_options() or return $Error::Last;
124
my $testsuite_dir = $self->option('TESTSUITE_DIR');
126
# Check if split mode (option '-s') is available
127
if ( $self->{SPLIT_MODE} ) {
128
if ( 0 != cmd(shq($testsuite_dir)."/run_tests -h | grep -e '\\-s '") ){
129
return error "Split mode isn't available with this version"
130
." of desktop test (".$self->{VERSION}.").";
134
cmd ("killall Xvfb"); # Should be done before calling guess_display()
138
cmd("rm -f ".shq($testsuite_dir)."/.configured");
141
cmd("rm -rf ".shq($testsuite_dir)."/gtkvts/results/*");
142
cmd("rm -rf ".shq($testsuite_dir)."/qt3/results/*");
143
cmd("rm -rf ".shq($testsuite_dir)."/fontconfig/results/*");
144
cmd("rm -rf ".shq($testsuite_dir)."/xft/results/*");
145
cmd("rm -rf ".shq($testsuite_dir)."/xrender/results/*");
146
cmd("rm -rf ".shq($testsuite_dir)."/freetype/results/*");
147
cmd("rm -f ".shq($testsuite_dir)."/xml/journal.libxml2");
148
cmd("rm -f ".shq($testsuite_dir)."/libpng/journal.pngtest");
149
cmd("rm -f ".shq($testsuite_dir)."/Qt/journal.qt");
150
cmd("rm -f ".shq($testsuite_dir)."/cairo/journal.cairo");
152
# Prepare a list of available subtests
153
# TODO: move to Manifest? ^^^
154
my @subtests = ( "libpng", "qt3", "fontconfig", "gtkvts", "xml" );
156
if ( version_filter("LSB >= 3.2", $globals->{'standard'}) || $self->option('with_qt4', "desktop_qt4") ) {
157
push @subtests, "qt4";
159
if ( version_filter("LSB >= 3.2", $globals->{'standard'}) ) {
160
push @subtests, "freetype", "xrender", "xft";
162
if ( version_filter("LSB 3.2", $globals->{'standard'}) ) {
163
# 'xrender' and 'xft' are trial in LSB 3.2
164
$self->{EXPECTED_JOURNALS}{$_}{TRIAL_USE} = 1 for ( "xrender", "xft" );
167
if ( version_filter("LSB >= 4.0", $globals->{'standard'}) ) {
168
push @subtests, "cairo";
171
for my $subname ( @subtests ) {
172
$self->{EXPECTED_JOURNALS}{$subname} ||= {};
175
$self->{SUBTESTS} = [@subtests];
178
if ( $short_scenario ) {
179
$self->{'scen_file'} = "/opt/lsb/test/desktop/gtkvts/scenarios/func_scen";
181
is_ok backup_and_replace( $self->{'scen_file'},
182
$globals->{'script_directory'}."/Tests/gtkvts_short_scen" )
183
or return error "Failed to replace the scenario", $Error::Last;
185
inform "Using short scenario.";
192
my ($self, $s_opt) = @_;
194
if ( $self->{SPLIT_MODE} ) {
196
foreach my $subname ( @{$self->{SUBTESTS}} ) {
198
my $s_opt = $opt_names{$subname};
200
warning "No option for desktop::$subname";
204
is_ok $self->run_sub($s_opt) or do {
205
$self->report_error($Error::Last);
206
$self->{RUN_PROBLEMS} = 1;
210
cmd("killall Xvfb"); sleep 1;
216
return $self->run_sub();
221
my ($self, $s_opt) = @_;
223
# Check whether the '-a' option is supported
224
my $automatic_option =
225
( 0 == cmd( shq($self->{TESTSUITE_DIR}."/run_tests")." -h | grep -e '\\-a '") );
227
my $subshell = $self->Spawn_subshell();
228
is_ok $subshell or return $Error::Last;
230
# Change to the test suite directory
232
$subshell->Send( "cd ".shq($self->{TESTSUITE_DIR})."\n" );
234
# Prepare the command
235
my $command = "./run_tests";
236
if ( $s_opt ) { # execute only one test
237
$command .= " -s ".$s_opt;
239
# All automatic tests
240
$command .= " -a" if $automatic_option;
242
if ( $self->option('with_qt4', "desktop_qt4") ) {
243
$command .= " -m QT4";
248
$subshell->Send("$command; exit\n"); # Run the test
250
my $questions_wait_time = 60*10; # In seconds
251
my $questions_deadline = time() + $questions_wait_time;
257
while ( $line = $subshell->Read($questions_wait_time) ) {
259
if ( $line =~ /Starting X Virtual Frame Buffer/ ) {
266
$subshell->Settle($line) or redo DIALOG_LOOP;
268
# Formalized questions
269
foreach my $opt ( values %{$self->{OPTIONS}} ) {
270
next if !defined $opt->{PRE} || !defined $opt->{VALUE};
272
my $pre = $opt->{PRE};
273
if ( $line =~ /$pre/ ) {
275
$subshell->Send( $opt->{VALUE}."\n" );
282
# Check the questions timeout
283
if ( time() > $questions_deadline ) {
284
inform "Time for questions is over.";
285
is_ok $subshell->ExpectLogout() or return $Error::Last;
286
return error "Timeout";
289
if ( $subshell->{TIMEOUT} ) { inform "!!! Warning: timeout at subshell"; }
291
# Just wait for the test finished
292
$subshell->WaitForSubshell();
295
return error "The test hasn't started";
304
return 1 if !$self->{EXPECTED_JOURNALS};
307
$self->{JOURNALS} = {}; # journal_filename => journal_type
309
my $testsuite_dir = $self->{TESTSUITE_DIR};
311
my $journal_location = { # TODO: move to manifest?
312
"gtkvts" => $testsuite_dir."/gtkvts/results/0*/journal",
313
"qt3" => $testsuite_dir."/qt3/results/0*/journal",
314
"fontconfig" => $testsuite_dir."/fontconfig/results/0*/journal",
315
"xft" => $testsuite_dir."/xft/results/0*/journal",
316
"xrender" => $testsuite_dir."/xrender/results/0*/journal",
317
"freetype" => $testsuite_dir."/freetype/results/0*/journal",
318
"xml" => $testsuite_dir."/xml/journal.libxml2",
319
"libpng" => $testsuite_dir."/libpng/journal.pngtest",
320
"qt4" => $testsuite_dir."/Qt/journal.qt",
321
"cairo" => $testsuite_dir."/cairo/journal.cairo",
324
foreach my $subname ( @{$self->{SUBTESTS}} ) {
325
my $obj = $self->{EXPECTED_JOURNALS}{$subname};
327
my $journal_file = "desktop_".$subname.".journal";
328
is_ok $self->copy_file_globbed( $journal_location->{$subname}, $globals->{'test_result_dir'}."/".$journal_file )
329
or $self->report_error($Error::Last);
330
$obj->{FILE} = $globals->{'test_result_dir'}."/".$journal_file;
331
$obj->{KIND} = 'TET';
334
$self->report_error(error("No journals from desktop/$subname test"));
338
# Pack $self->{JOURNALS}
339
# The JOURNALS should be string to be saved to the .info file.
341
foreach my $subname ( @{$self->{SUBTESTS}} ) {
342
my $obj = $self->{EXPECTED_JOURNALS}{$subname};
344
$packed .= $subname.":";
345
$packed .= join ",", map {$_."=".$obj->{$_}} keys %$obj;
349
$self->{JOURNALS} = $packed;
357
( $self->{JOURNALS} ) or return error("No journals");
359
# Unpack $self->{JOURNALS}: "key=value,key=value,..."
362
for my $s ( split /;/, $self->{JOURNALS} ) {
363
my ($subname, $data) = split /:/, $s, 2;
364
foreach my $pair ( split /,/, $data ) {
365
my ($key, $value) = split /=/, $pair;
366
$journals->{$subname}{$key} = $value;
368
push @subtests, $subname;
371
# Make journals table
372
my $journals_toc = {};
376
foreach my $subname ( @subtests ) {
377
my $obj = $journals->{$subname};
379
# Add an anchor for journals TOC
380
$report .= '<a name="'.html($subname).'"></a>'."\n";
382
my $title = "desktop/".$subname;
383
$report .= '<h2>'.html($title).'</h2>'."\n";
385
my $jstruct = { %$obj };
386
if ( !$obj->{FILE} ) {
387
local $Error::Debug = 0;
388
$report .= Report::ErrMessage("Journal file undefined");
391
$jstruct->{TESTSUITE} = $title;
393
# Print a link to the journal
394
$report .= '<p>Open the test '.Report::local_href( $jstruct->{FILE}, 'journal' ).'.</p>';
396
is_ok Report::ParseJournal( $jstruct )
398
local $Error::Debug = 0;
399
$report .= Report::ErrMessage( error("Failed to parse journal: ".$jstruct->{FILE}, $Error::Last)->tostring() );
400
push @verdicts, 'run_problems';
404
if ( $subname eq 'cairo' ) {
405
# cairo journal is malformed and it cause many INFO_TABLES to appear. Truncate them.
406
$#{$jstruct->{INFO_TABLES}} = 1 if $jstruct->{INFO_TABLES} && $#{$jstruct->{INFO_TABLES}} > 2;
409
# Print the errors table
410
$report .= Report::JournalReport($jstruct);
411
# Print the statistics
412
$report .= Report::print_stats($jstruct->{STATS});
414
my $journal_verdict = Report::verdict( $jstruct->{STATS} );
415
push @verdicts, $journal_verdict;
416
push @{$journals_toc->{ROWS}}, {
417
LEFT => '<a href="#'.html($subname).'">'.html($title).'</a>',
418
RIGHT => Report::verdict_text($journal_verdict),
419
BG_COLOR => Report::verdict_color($journal_verdict),
423
$self->{VERDICT} = Report::overall_verdict(@verdicts);
425
$journals_toc->{TITLE} = 'Test journals';
426
$self->report( Report::print_info_table($journals_toc) );
428
$self->report($report);
438
if ( $short_scenario ) {
439
# Put back the original scenario
440
my $scen_file = $self->{'scen_file'}; # May be undefined
441
if ( $scen_file && -f "$scen_file.orig") {
442
cmd( "cp -f ".shq($scen_file).".orig ".shq($scen_file) );
added
removed
utils/Tests/Desktop_test.pm
