#! /usr/bin/env perl
BEGIN {
use_ok
'Device::Modbus::TCP::ADU'
;
}
{
my
$adu
= Device::Modbus::TCP::ADU->new;
isa_ok
$adu
,
'Device::Modbus::ADU'
;
my
@fields
=
qw(id length)
;
foreach
my
$field
(
@fields
) {
eval
{
$adu
->
$field
;
};
ok
defined
$@,
"$field accessor dies with undefined value"
;
like $@,
qr/not been declared/
,
"Accessor die message for undefined $field is correct"
;
}
foreach
my
$field
(
@fields
) {
$adu
->
$field
(
'tested OK'
);
is
$adu
->
$field
,
'tested OK'
,
"Accessor/mutator for $field works correctly"
;
}
}
{
my
$adu
= Device::Modbus::TCP::ADU->new(
id
=> 3,
unit
=> 4,
message
=> Device::Modbus::Request->new(
function
=>
'Write Single Coil'
,
address
=> 24,
value
=> 1
)
);
isa_ok
$adu
,
'Device::Modbus::ADU'
;
is
$adu
->id, 3,
'ID set correctly by object constructor'
;
is
$adu
->unit, 4,
'Unit set correctly by object constructor'
;
is_deeply [
unpack
'nnnC'
,
$adu
->build_header], [3, 0, 6, 4],
'Header calculated correctly'
;
is_deeply [
unpack
'nnnCCnn'
,
$adu
->binary_message],
[3, 0, 6, 4, 5, 24, 0xFF00 ],
'Binary message was calculated correctly'
;
}
{
my
$adu
= Device::Modbus::TCP::ADU->new(
id
=> 3,
message
=> Device::Modbus::Request->new(
function
=>
'Write Single Coil'
,
address
=> 24,
value
=> 1
)
);
isa_ok
$adu
,
'Device::Modbus::ADU'
;
is
$adu
->unit, 0xFF,
'Unit number by default is 0xFF'
}
done_testing();