La séptima vida

...o el gato así lo espera/teme

Testing Device::Modbus::RTU::Server

The difficulties for testing Device::Modbus::RTU::Server are mainly three:

  1. It reads its input from the serial port
  2. It runs in a loop that ends only with a SIGINT
  3. It logs useful information to its standard output

To test this module, serial port input must be faked so that the server reads testing strings. STDOUT must be redirected somewhere so that the logs may be exploited and, to stop the server, a SIGINT must be sent to the test program some time after starting it.

To fake input from the serial port, I created a module that acts like Device::SerialPort and which lives in t/lib. With use lib 't/lib' in the test programs, it is this fake module that is loaded and not the real Device::SerialPort. The fake module returns a prepared string for every call to read. Output written to the port goes instead into an array in the fake serial port module so that it can be tested. The interesting part of the fake Device::SerialPort is this:

package Device::SerialPort;

use strict;
use warnings;
use v5.10;

my @rx_buffer = ();
my @wx_buffer = ();

sub read {
    my ($self, $chars) = @_;
    my $string = shift @rx_buffer;
    $string //= '';
#    say STDERR "# Reading from serial port: ",
#        join '-', unpack 'H*', $string
#        if $string;
    return length $string, $string;
}

sub write {
    my ($self, $string) = @_;
    push @wx_buffer, $string;
    return length $string;
}

sub add_test_strings {
    my ($class, @strings) = @_;
    push @rx_buffer, @strings;
}

sub get_test_string {
    my $class = shift;
    return shift @wx_buffer;
}

This line prepares the fake input that will be read by the server:

Device::SerialPort->add_test_strings(pack 'H*', '03120003ff007676');

In this case, it is a Modbus request that is rejected as an exception for a non-supported function, code 12.

To stop the server, test programs contain an alarm that is activated after one second. The signal handler for this alarm sends the INT signal required to break from the main loop of the server. Note that SIGINT is signal number two:

# Send an alarm signal in one second.
# Then, send a SIGINT to stop the server.
$SIG{ALRM} = sub { kill 2, $$ };
alarm(1);

Finally, in order to capture the logs, STDOUT is closed and re-opened on a scalar reference:

# Logging prints directly to STDOUT.
close STDOUT;
my $out = '';
open STDOUT, '>', \$out or die "Could not open LOG for writing: $!";

Sadly, I was not successful at measuring the new test coverage for the RTU distribution. This post ends with one of the server test programs:

use Test::More tests => 8;
use lib 't/lib';
use strict;
use warnings;
use v5.10;

BEGIN {
    use_ok 'Device::Modbus::RTU::Server';
}

# Logging prints directly to STDOUT.
close STDOUT;
my $out = '';
open STDOUT, '>', \$out or die "Could not open LOG for writing: $!";

# Send an alarm signal in one second.
# Then, send a SIGINT to stop the server.
$SIG{ALRM} = sub { kill 2, $$ };
alarm(1);

{
   package My::Unit;
   our @ISA = ('Device::Modbus::Unit');

   sub init_unit {
       my $unit = shift;

       #                Zone            addr qty   method
       #           -------------------  ---- ---  ---------
       $unit->get('holding_registers',    2,  1,  'get_addr_2');
   }
 
   sub get_addr_2 {
       my ($unit, $server, $req, $addr, $qty) = @_;
       say "Executed server routine for address 2, 1 register";
       return 6;
   }
}
 
 
my $server = Device::Modbus::RTU::Server->new(
   port      =>  '/dev/ttyACM0',
   baudrate  => 9600,
   parity    => 'none',
   log_level => 4
);
isa_ok $server, 'Device::Modbus::Server';
 
my $unit = My::Unit->new(id => 3);
$server->add_server_unit($unit);
isa_ok $unit, 'Device::Modbus::Unit';

# Add test request to fake serial port:
# Get an exception
# Request unit 3, function 5 (write single coil), addr 3, val 0xff00
Device::SerialPort->add_test_strings(pack 'H*', '03120003ff007676');

$server->start;

# Alarm stops the server. Test for logging:
like $out, qr/Starting server/,           'Server started';
like $out, qr/Exception while waiting/,   'Unsupported function';
like $out, qr/Device::Modbus::Exception/, 'Server returned an exception';
like $out, qr/Server is shutting down/,   'Server shuts down';
like $out, qr/Server is down/,            'Disconnection was logged';

# note $out;

done_testing();