File Coverage

autotest.pm
Criterion Covered Total %
statement 474 532 89.4
total 474 532 89.4


line stmt code
1   # Copyright 2009-2013 Bernhard M. Wiedemann
2   # Copyright 2012-2021 SUSE LLC
3   # SPDX-License-Identifier: GPL-2.0-or-later
4    
5    
6   use Mojo::Base -strict, -signatures;
7 70  
  70  
  70  
8   use bmwqemu;
9 70 use Exporter 'import';
  70  
  70  
10 70 use File::Basename;
  70  
  70  
11 70 use Socket;
  70  
  70  
12 70 use IO::Handle;
  70  
  70  
13 70 use POSIX '_exit';
  70  
  70  
14 70 use cv;
  70  
  70  
15 70 use signalblocker;
  70  
  70  
16 70 use Scalar::Util 'blessed';
  70  
  70  
17 70 use Mojo::IOLoop::ReadWriteProcess 'process';
  70  
  70  
18 70 use Mojo::IOLoop::ReadWriteProcess::Session 'session';
  70  
  70  
19 70 use Mojo::File qw(path);
  70  
  70  
20 70  
  70  
  70  
21   our @EXPORT_OK = qw(loadtest $selected_console $last_milestone_console query_isotovideo);
22    
23   our %tests; # scheduled or run tests
24   our @testorder; # for keeping them in order
25   our $isotovideo;
26   our $process;
27   our $tests_running = 0;
28   =head1 Introduction
29    
30   OS Autoinst decides which test modules to run based on a distribution specific
31   script called main.pm. This is either located in $vars{PRODUCTDIR} or
32   $vars{CASEDIR} (e.g. <distribution>/products/<product>/main.pm).
33    
34   This script does not actually run the tests, but queues them to be run by
35   autotest.pm. A test is queued by calling the loadtest function which is also
36   located in autotest.pm. The test modules are executed in the same order that
37   loadtest is called.
38    
39   =cut
40    
41   my $casedir = $bmwqemu::vars{CASEDIR};
42 266 my $script_override_path = join('/', $bmwqemu::vars{ASSETDIR} // '', 'other', $script);
  266  
  266  
43 266 if (-f $script_override_path) {
44 266 bmwqemu::diag("Found override test module for $script: $script_override_path");
45 266 return path($script_override_path)->to_rel($casedir);
46 0 }
47 0 elsif (!-f join('/', $casedir, $script)) {
48   warn "loadtest needs a script below $casedir - $script is not\n";
49   return path($script)->to_rel($casedir);
50 2 }
51 2 return "$casedir/$script";
52   }
53 264  
54   =head2 loadtest
55    
56   loadtest(<string>, [ name => <string>, run_args => <OpenQA::Test::RunArgs> ]);
57    
58   Queue a test module for execution by the test runner. The first argument is
59   mandatory and specifies the Perl module name containing the test code to be run.
60    
61   The next two arguments are optional and rarely used. First there is name which
62   can be used to give the test a different display name from the Perl source
63   file.
64    
65   Then there is the run_args object, which must be a subclass of
66   OpenQA::Test::RunArgs. This is passed to the run() method of the test module
67   when it is executed. This is useful if you need to load the same test module
68   multiple times within a single test, but with different parameters each time.
69    
70   Usually get_var and set_var are used to pass parameters to a test. However if
71   you use set_var multiple times inside main.pm then the final value you set
72   will be the one seen by all tests. Regardless of whether the tests were loaded
73   before or after the variable was set.
74    
75   Both optional arguments were created for integrating a third party test suites
76   or test runners into OpenQA. In such cases the same test module may be
77   dynamically queued multiple times to execute different test cases within the
78   third party test suite.
79    
80   Prefers test module files found in the openQA asset folder "other/" over
81   corresponding files within the "CASEDIR" tree to allow temporary overrides,
82   e.g. by making use of the openQA asset download feature.
83    
84   =cut
85    
86   no utf8; # Inline Python fails on utf8, so let's exclude it here
87   my $casedir = $bmwqemu::vars{CASEDIR};
88 266 my $script_path = find_script($script);
  266  
  266  
  266  
89 70 my ($name, $category) = parse_test_path($script_path);
  70  
  70  
90 266 my $test;
91 266 my $fullname = "$category-$name";
92 266 # perl code generating perl code is overcool
93 265 my $code = "package $name;";
94 265 $code .= "use lib '.';" unless path($casedir)->is_abs;
95   $code .= "use lib '$casedir/lib';";
96 265 my $basename = dirname($script_path);
97 265 $code .= "use lib '$basename';";
98 265 die "Unsupported file extension for '$script'" unless $script =~ /\.p[my]/;
99 265 my $is_python = 0;
100 265 if ($script =~ m/\.pm$/) {
101 265 $code .= "require '$script_path';";
102 265 }
103 265 elsif ($script =~ m/\.py$/) {
104 242 # Adding the include path of os-autoinst into python context
105   my $inc = File::Basename::dirname(__FILE__);
106   $code .= "
107   use base 'basetest';
108 23 use Mojo::File 'path';
109 23 use Inline Python => 'import sys; sys.path.append(\"$inc\")';
110   use Inline Python => path('$casedir/$script')->slurp;
111   ";
112   $is_python = 1;
113   }
114   eval $code;
115 23 if (my $err = $@) {
116   if ($is_python) {
117 265 eval "use Inline Python => 'sys.stderr.flush()';";
  26  
  26  
  26  
  26  
  26  
  26  
  25  
  25  
  25  
  22  
  22  
  22  
  22  
  22  
  22  
  22  
  22  
  22  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  21  
  14  
  14  
  14  
  14  
  14  
  14  
  2  
  2  
  2  
  2  
  2  
  2  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
  1  
118 265 bmwqemu::fctwarn("Unable to flush Python's stderr, error message from Python might be missing: $@") if $@; # uncoverable statement
119 2 }
120 1 my $msg = "error on $script: $err";
  1  
  1  
  1  
121 1 bmwqemu::fctwarn($msg);
122   bmwqemu::serialize_state(component => 'tests', msg => "unable to load $script, check the log for the cause (e.g. syntax error)");
123 2 die $msg;
124 2 }
125 2 $test = $name->new($category);
126 2 $test->{script} = $script;
127   $test->{fullname} = $fullname;
128 263 $test->{serial_failures} = $testapi::distri->{serial_failures} // [];
129 263 $test->{autoinst_failures} = $testapi::distri->{autoinst_failures} // [];
130 263  
131 263 if (defined $args{run_args}) {
132 263 unless (blessed($args{run_args}) && $args{run_args}->isa('OpenQA::Test::RunArgs')) {
133   die 'The run_args must be a sub-class of OpenQA::Test::RunArgs';
134 263 }
135 2 $test->{run_args} = $args{run_args};
136 1 delete $args{run_args};
137   }
138 1  
139 1 my $nr = '';
140   while (exists $tests{$fullname . $nr}) {
141   # to all perl hardcore hackers: fuck off!
142 262 $nr = $nr eq '' ? 1 : $nr + 1;
143 262 $test->{name} = join("#", $name, $nr);
144   }
145 58 if ($args{name}) {
146 58 $test->{name} = $args{name};
147   }
148 262  
149 2 $tests{$fullname . $nr} = $test;
150    
151   return unless $test->is_applicable;
152 262 push @testorder, $test;
153    
154 262 # Test schedule may change at runtime. Update test_order.json to notify
155 119 # the OpenQA server of the change.
156   write_test_order() if $tests_running;
157   bmwqemu::diag("scheduling $test->{name} $script");
158   }
159 119  
160 119 our $current_test;
161   our $selected_console;
162   our $last_milestone;
163   our $last_milestone_console;
164    
165   unless ($script_path =~ m,(\w+)/([^/]+)\.p[my]$,) {
166   die "loadtest: script path '$script_path' does not match required pattern \\w.+/[^/]+.p[my]\n";
167   }
168 269 my $category = $1;
  269  
  269  
169 269 my $name = $2;
170 1 if ($category ne 'other') {
171   # show full folder hierarchy as category for non-sideloaded tests
172 268 my $pattern = qr,(tests/[^/]+/)?tests/([\w/]+)/([^/]+)\.p[my]$,;
173 268 if ($script_path =~ $pattern) {
174 268 $category = $2;
175   }
176 267 }
177 267 return ($name, $category);
178 238 }
179    
180   $current_test = $test;
181 268 query_isotovideo(
182   'set_current_test',
183   $current_test ?
184 104 {
  104  
  104  
185 104 name => $current_test->{name},
186   full_name => $current_test->{fullname},
187   }
188   : {});
189   }
190    
191   my @result;
192   for my $t (@testorder) {
193 104 push(
194   @result,
195   {
196 40 name => $t->{name},
  40  
197 40 category => $t->{category},
198 40 flags => $t->test_flags(),
199   script => $t->{script}});
200   }
201   bmwqemu::save_json_file(\@result, bmwqemu::result_dir . "/test_order.json");
202   }
203    
204   bmwqemu::diag("Creating a VM snapshot $sname");
205 246 return query_isotovideo('backend_save_snapshot', {name => $sname});
206   }
207 40  
208   bmwqemu::diag("Loading a VM snapshot $sname");
209   my $command = query_isotovideo('backend_load_snapshot', {name => $sname});
210 0 # On VMware VNC console needs to be re-selected after snapshot revert,
  0  
  0  
211 0 # so the screen is refreshed. Same with serial console.
212 0 return unless ($command // '') eq 'vmware_fixup';
213   testapi::select_console('sut');
214   query_isotovideo('backend_stop_serial_grab');
215 14 query_isotovideo('backend_start_serial_grab');
  14  
  14  
216 14 }
217 14  
218   close $isotovideo; # uncoverable statement
219   Devel::Cover::report() if Devel::Cover->can('report'); # uncoverable statement
220 14 _exit(0); # uncoverable statement
221 0 }
222 0  
223 0 my $died = 0;
224   my $completed = 0;
225   $tests_running = 1;
226 0 eval { $completed = autotest::runalltests(); };
  0  
227 0 if ($@) {
228 0 warn $@;
229 0 $died = 1; # test execution died
230   }
231   eval {
232 21 bmwqemu::save_vars(no_secret => 1);
  21  
233 21 myjsonrpc::send_json($isotovideo, {cmd => 'tests_done', died => $died, completed => $completed});
234 21 };
235 21 _terminate;
236 21 }
  21  
237 21  
238 2 if ($current_test) {
239 2 bmwqemu::diag("autotest received signal $sig, saving results of current test before exiting");
240   $current_test->result('canceled');
241 21 $current_test->save_test_result();
242 21 }
243 21 _exit(1);
244   }
245 21  
246   my $child;
247   socketpair($child, $isotovideo, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
248 0 or die "socketpair: $!";
  0  
  0  
249 0  
250 0 $child->autoflush(1);
251 0 $isotovideo->autoflush(1);
252 0  
253   $process = process(sub {
254 0 close $child;
255   $SIG{TERM} = \&handle_sigterm;
256   $SIG{INT} = 'DEFAULT';
257 14 $SIG{HUP} = 'DEFAULT';
  14  
258 14 $SIG{CHLD} = 'DEFAULT';
259 14  
260   my $signal_blocker = signalblocker->new;
261   cv::init;
262 14 require tinycv;
263 14 tinycv::create_threads();
264   undef $signal_blocker;
265    
266 0 $0 = "$0: autotest";
267 0 my $line = <$isotovideo>;
268 0 if (!$line) {
269 0 _exit(0);
270 0 }
271   print "GOT $line\n";
272 0 # the backend process might have added some defaults for the backend
273 0 bmwqemu::load_vars();
274 0  
275 0 run_all;
276 0 },
277   sleeptime_during_kill => 0.1,
278 0 total_sleeptime_during_kill => 5,
279 0 blocking_stop => 1,
280 0 separate_err => 0,
281 0 set_pipes => 0,
282   internal_pipes => 0)->start;
283 0 $process->on(collected => sub { bmwqemu::diag "[" . __PACKAGE__ . "] process exited: " . shift->exit_status; });
284    
285 0 close $isotovideo;
286   return ($process, $child);
287 0 }
288    
289 14 # deep copy
290   my %json;
291   if ($args) {
292   %json = %$args;
293   }
294   $json{cmd} = $cmd;
295 14  
  3  
296   die "isotovideo is not initialized. Ensure that you only call test API functions from test modules, not schedule code\n" unless defined $isotovideo;
297 14 myjsonrpc::send_json($isotovideo, \%json);
298 14  
299   # wait for response (if test is paused, this will block until resume)
300   my $rsp = myjsonrpc::read_json($isotovideo);
301 794  
  794  
  794  
  794  
302   return $rsp->{ret};
303 794 }
304 794  
305 219 die "ERROR: no tests loaded" unless @testorder;
306    
307 794 my $firsttest = $bmwqemu::vars{SKIPTO} || $testorder[0]->{fullname};
308   my $vmloaded = 0;
309 794 my $snapshots_supported = query_isotovideo('backend_can_handle', {function => 'snapshots'});
310 793 bmwqemu::diag "Snapshots are " . ($snapshots_supported ? '' : 'not ') . "supported";
311    
312   write_test_order();
313 793  
314   for (my $testindex = 0; $testindex <= $#testorder; $testindex++) {
315 793 my $t = $testorder[$testindex];
316   my $flags = $t->test_flags();
317   my $fullname = $t->{fullname};
318 22  
  22  
319 22 if (!$vmloaded && $fullname eq $firsttest) {
320   if ($bmwqemu::vars{SKIPTO}) {
321 20 if ($bmwqemu::vars{TESTDEBUG}) {
322 20 load_snapshot('lastgood');
323 20 }
324 19 else {
325   load_snapshot($firsttest);
326 19 }
327   }
328 19 $vmloaded = 1;
329 58 }
330 58 if (!$vmloaded) {
331 58 bmwqemu::diag "skipping $fullname";
332   $t->skip_if_not_running();
333 58 $t->save_test_result();
334 19 next;
335 0 }
336 0  
337   my $name = $t->{name};
338   bmwqemu::modstate "starting $name $t->{script}";
339 0 $t->start();
340    
341   # avoid erasing the good vm snapshot
342 19 if ($snapshots_supported && (($bmwqemu::vars{SKIPTO} || '') ne $fullname) && $bmwqemu::vars{MAKETESTSNAPSHOTS}) {
343   make_snapshot($t->{fullname});
344 58 }
345 0  
346 0 eval { $t->runtest; };
347 0 my $error = $@; # save $@, it might be overwritten
348 0 $t->save_test_result();
349   my $next_test = $testorder[$testindex + 1];
350    
351 58 if ($error) {
352 58 my $msg = $error;
353 58 if ($msg !~ /^test.*died/) {
354   # avoid duplicating the message
355   bmwqemu::diag $msg;
356 58 }
357 0 if ($bmwqemu::vars{DUMP_MEMORY_ON_FAIL}) {
358   query_isotovideo('backend_save_memory_dump', {filename => $fullname});
359   }
360 58 if ($t->{fatal_failure} || $flags->{fatal} || (!exists $flags->{fatal} && !$snapshots_supported) || $bmwqemu::vars{TESTDEBUG}) {
  58  
361 58 my $reason = ($t->{fatal_failure} || $flags->{fatal})
362 58 ? 'after a fatal test failure'
363 58 : ($bmwqemu::vars{TESTDEBUG}
364   ? 'because TESTDEBUG has been set'
365 58 : 'because snapshotting is disabled/unavailable and "fatal => 0" has NOT been set explicitly');
366 30 bmwqemu::diag "stopping overall test execution $reason";
367 30 bmwqemu::stop_vm();
368   return 0;
369 12 }
370   elsif (defined $next_test && !$flags->{no_rollback} && $last_milestone) {
371 30 load_snapshot('lastgood');
372 0 $next_test->record_resultfile('Snapshot', "Loaded snapshot because '$name' failed", result => 'ok');
373   $last_milestone->rollback_activated_consoles();
374 30 }
375   }
376   else {
377   if (defined $next_test && !$flags->{no_rollback} && $last_milestone && $flags->{always_rollback}) {
378 7 load_snapshot('lastgood');
379   $next_test->record_resultfile('Snapshot', "Loaded snapshot after '$name' (always_rollback)", result => 'ok') if $next_test;
380 7 $last_milestone->rollback_activated_consoles();
381 7 }
382 7 my $makesnapshot = $bmwqemu::vars{TESTDEBUG};
383   # Only make a snapshot if there is a next test and it's not a fatal milestone
384   if (defined $next_test) {
385 14 my $nexttestflags = $next_test->test_flags();
386 14 $makesnapshot ||= $flags->{milestone} && !($nexttestflags->{milestone} && $nexttestflags->{fatal});
387 14 }
388   if ($snapshots_supported && $makesnapshot) {
389   make_snapshot('lastgood');
390   $last_milestone = $t;
391 28 $last_milestone_console = $selected_console;
392 1 }
393 1 }
394 1 }
395   return 1;
396 28 }
397    
398 28 die "need argument \$dir" unless $dir;
399 20 $dir =~ s/^\Q$bmwqemu::vars{CASEDIR}\E\/?//; # legacy where absolute path is specified
400 20 $dir = join('/', $bmwqemu::vars{CASEDIR}, $dir); # always load from casedir
401   die "'$dir' does not exist!\n" unless -d $dir;
402 28 foreach my $script (glob "$dir/*.pm") {
403 2 loadtest($script);
404 2 }
405 2 }
406    
407   1;