Merge pull request #1986 from okurz/feature/signatures_in_most_of_bac…

…kends_and_consoles

Use signatures in most of backend/ and consoles/ as possible

backend/console_proxy.pm

@@ -14,9 +14,7 @@ use Mojo::Base -strict, -signatures;
 use feature 'say';
 
 sub new ($class, $console) {
-
     my $self = bless({class => $class, console => $console}, $class);
-
     return $self;
 }
 
@@ -43,10 +41,8 @@ sub AUTOLOAD ($self, @args) {
 
         bmwqemu::log_call(wrapped_call => $wrapped_call);
         my $wrapped_retval = autotest::query_isotovideo('backend_proxy_console_call', $wrapped_call);
+        die $wrapped_retval->{exception} if exists $wrapped_retval->{exception};
 
-        if (exists $wrapped_retval->{exception}) {
-            die $wrapped_retval->{exception};
-        }
         # get more screenshots from consoles, especially from x3270 on s390
         $autotest::current_test->take_screenshot;
 

backend/qemu.pm

@@ -556,7 +556,7 @@ sub start_qemu ($self) {
 
     my $qemuimg = find_bin('/usr/bin/', qw(kvm-img qemu-img));
 
-    local *sp = sub { $self->{proc}->static_param(@_); };
+    local *sp = sub (@args) { $self->{proc}->static_param(@args); };
     $vars->{VIRTIO_CONSOLE} = 1 if ($vars->{VIRTIO_CONSOLE} // '') ne 0;
 
     unless ($qemubin) {

consoles/VNC.pm

@@ -545,7 +545,7 @@ my $keymap_ikvm = {
     '/' => 0x38,
 };
 
-sub shift_keys {
+sub shift_keys () {
     # see http://en.wikipedia.org/wiki/IBM_PC_keyboard
     return {
         '~' => '`',
@@ -1035,7 +1035,7 @@ sub _receive_colour_map ($self) {
 }
 
 # Discard the bell signal
-sub _receive_bell { 1 }
+sub _receive_bell ($self) { 1 }
 
 sub _receive_ikvm_session ($self) {
     $self->socket->read(my $ikvm_session_infos, 264);

consoles/amtSol.pm

@@ -83,6 +83,6 @@ sub disable ($self) {
 }
 
 # we have no screen
-sub screen { }
+sub screen ($self) { }
 
 1;

consoles/console.pm

@@ -50,7 +50,7 @@ sub screen ($self) {
 }
 
 # to be overloaded
-sub trigger_select { }
+sub trigger_select ($self) { }
 
 sub select ($self) {
     my $activated;
@@ -65,9 +65,9 @@ sub select ($self) {
     return $activated;
 }
 
-sub activate { }
+sub activate ($self) { }
 
-sub is_serial_terminal { 0 }
+sub is_serial_terminal ($self) { 0 }
 
 sub set_args ($self, %args) {
     my $my_args = $self->{args};

consoles/ipmiSol.pm

@@ -87,7 +87,6 @@ sub disable ($self) {
     return $ret;
 }
 
-# we have no screen
-sub screen { }
+sub screen ($self) { }
 
 1;

consoles/network_console.pm

@@ -21,6 +21,6 @@ sub activate ($self) {
 }
 
 # to be overwritten
-sub connect_remote { }
+sub connect_remote ($self, $args) { }
 
 1;

consoles/serial_screen.pm

@@ -42,9 +42,9 @@ sub send_key ($self, $nargs) {
     $self->type_string($nargs);
 }
 
-sub hold_key { croak $trying_to_use_keys }
+sub hold_key ($self, $args) { croak $trying_to_use_keys }
 
-sub release_key { croak $trying_to_use_keys }
+sub release_key ($self, $args) { croak $trying_to_use_keys }
 
 =head2 type_string
 
@@ -84,7 +84,7 @@ sub type_string ($self, $nargs) {
     croak "Was not able to write entire message to virtio/svirt serial terminal. Only $written of $nargs->{text}" if $written < length($text);
 }
 
-sub thetime { clock_gettime(CLOCK_MONOTONIC) }
+sub thetime () { clock_gettime(CLOCK_MONOTONIC) }
 
 sub elapsed ($start) {
     no integer;
@@ -274,8 +274,8 @@ sub peak ($self, %nargs) {
     return $self->{carry_buffer};
 }
 
-sub current_screen { 0 }
+sub current_screen ($self) { 0 }
 
-sub request_screen_update { }
+sub request_screen_update ($self) { }
 
 1;

consoles/sshIucvconn.pm

@@ -44,7 +44,6 @@ sub kill_ssh ($self) {
     $self->backend->stop_ssh_serial;
 }
 
-# we have no screen
-sub screen { }
+sub screen ($self) { }
 
 1;

consoles/sshVirtshSUT.pm

@@ -26,7 +26,7 @@ sub new ($class, $testapi_console, $args) {
     return $self;
 }
 
-sub screen { shift->{screen} }
+sub screen ($self) { $self->{screen} }
 
 sub disable ($self) {
     return unless $self->{ssh};
@@ -46,6 +46,6 @@ sub activate ($self) {
     return;
 }
 
-sub is_serial_terminal { 1 }
+sub is_serial_terminal ($self) { 1 }
 
 1;

t/26-serial_screen.t

@@ -23,5 +23,6 @@ dies_ok { $screen->hold_key } 'hold_key dies with error';
 dies_ok { $screen->release_key } 'release_key dies with error';
 dies_ok { $screen->send_key({key => 'space'}) } 'send_key dies for most keys';
 is $screen->current_screen, 0, 'no current screen';
+is $screen->request_screen_update, undef, 'can call request_screen_update';
 
 done_testing;

t/27-consoles-amt_sol.t

@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+# Copyright SUSE LLC
+# SPDX-License-Identifier: GPL-2.0-or-later
+
+use Test::Most;
+use Mojo::Base -strict, -signatures;
+use Test::Warnings qw(:all :report_warnings);
+use FindBin '$Bin';
+use lib "$Bin/../external/os-autoinst-common/lib";
+use OpenQA::Test::TimeLimit '5';
+use consoles::amtSol;
+
+my $c = consoles::amtSol->new('sut', {});
+is $c->screen, undef, 'can call screen';
+
+done_testing;

t/27-consoles-network_console.t

@@ -0,0 +1,18 @@
+#!/usr/bin/perl
+
+# Copyright SUSE LLC
+# SPDX-License-Identifier: GPL-2.0-or-later
+
+use Test::Most;
+use Mojo::Base -strict, -signatures;
+use Test::Warnings qw(:all :report_warnings);
+use FindBin '$Bin';
+use lib "$Bin/../external/os-autoinst-common/lib";
+use OpenQA::Test::TimeLimit '5';
+use consoles::network_console;
+
+my $c = consoles::network_console->new('sut', {});
+is $c->activate, undef, 'can call activate';
+is $c->connect_remote(undef), undef, 'connect_remote can be called, to be overwritten';
+
+done_testing;

t/27-consoles-ssh_virtsh_sut.t

@@ -0,0 +1,18 @@
+#!/usr/bin/perl
+
+# Copyright SUSE LLC
+# SPDX-License-Identifier: GPL-2.0-or-later
+
+use Test::Most;
+use Mojo::Base -strict, -signatures;
+use Test::Warnings qw(:all :report_warnings);
+use FindBin '$Bin';
+use lib "$Bin/../external/os-autoinst-common/lib";
+use OpenQA::Test::TimeLimit '5';
+use consoles::sshVirtshSUT;
+
+my $c = consoles::sshVirtshSUT->new('sut', {});
+is $c->screen, undef, 'no screen defined';
+is $c->is_serial_terminal, 1, 'is a serial terminal';
+
+done_testing;

t/27-consoles-vnc.t

@@ -29,6 +29,7 @@ $s->mock('read', sub { $_[1] = $s->mocked_read; 1 });
 $inet_mock->redefine(new => $s);
 $vnc_mock->noop('_server_initialization');
 is $c->login, undef, 'can call login';
+is $c->_receive_bell, 1, 'can call _receive_bell';
 
 subtest 'send update request' => sub {
     $c->width(1024);

xt/01-style.t

@@ -13,6 +13,7 @@ ok system(qq{git grep -I -l '[#/ ]*SPDX-License-Identifier ' ':!COPYING' ':!exte
 is qx{git grep -I -L '^use Test::Most' t/**.t}, '', 'All tests use Test::Most';
 is qx{git grep -I -L '^use Test::Warnings' t/**.t}, '', 'All tests use Test::Warnings';
 is qx{git grep -I -l '^use testapi' backend/ consoles/}, '', 'No backend or console files use external facing testapi';
+is qx{git grep -l -e 'sub \\S\\+ [^(]\\+' --and --not -e 'sub [(\{]' --and --not -e 'sub \\S\\+(' backend/ consoles/}, '', 'All backends and consoles use sub signatures everywhere (nameless still allowed)';
 is qx{git grep -L '^#!.*perl' t/**.t}, '', 'All test files have shebang';
 is qx{git ls-files -s t/**.t | grep -v ^1007}, '', 'All test modules are executable';
 is qx{git grep -l '^use POSIX;'}, '', 'Use of bare POSIX import is discouraged, see https://perldoc.perl.org/POSIX';