+ duplicate checker tests
git-svn-id: http://repo.ham.fi/svn/aprsc/trunk@310 3ce903b1-3385-4e86-93cd-f9a4a239f7ac
This commit is contained in:
parent
e7b90ddad6
commit
0e0b622cad
|
|
@ -41,12 +41,13 @@ sub txrx($$$$$)
|
|||
&$ok(1, 1, "ok");
|
||||
}
|
||||
|
||||
sub should_drop($$$$$)
|
||||
sub should_drop($$$$$;$)
|
||||
{
|
||||
my($ok, $i_tx, $i_rx, $tx, $helper) = @_;
|
||||
my($ok, $i_tx, $i_rx, $tx, $helper, $no_random_drop) = @_;
|
||||
|
||||
my $drop_key = 'drop.' . int(rand(1000000));
|
||||
my $sent = $i_tx->sendline($tx . ' ' . $drop_key);
|
||||
my $drop_key = '';
|
||||
$drop_key .= ' drop.' . int(rand(1000000)) if (!$no_random_drop);
|
||||
my $sent = $i_tx->sendline($tx . $drop_key);
|
||||
|
||||
if (!$sent) {
|
||||
&$ok($sent, 1, "Failed to send line to server: '$tx'");
|
||||
|
|
|
|||
|
|
@ -0,0 +1,81 @@
|
|||
#
|
||||
# Test duplicate detection capability
|
||||
#
|
||||
|
||||
use Test;
|
||||
BEGIN { plan tests => 17 };
|
||||
use runproduct;
|
||||
use istest;
|
||||
use Ham::APRS::IS;
|
||||
ok(1); # If we made it this far, we're ok.
|
||||
|
||||
my $p = new runproduct('basic');
|
||||
|
||||
ok(defined $p, 1, "Failed to initialize product runner");
|
||||
ok($p->start(), 1, "Failed to start product");
|
||||
|
||||
my $login = "N0CALL-1";
|
||||
my $server_call = "TESTING";
|
||||
my $i_tx = new Ham::APRS::IS("localhost:14580", $login);
|
||||
ok(defined $i_tx, 1, "Failed to initialize Ham::APRS::IS");
|
||||
|
||||
my $i_rx = new Ham::APRS::IS("localhost:10152", "N0CALL-2");
|
||||
ok(defined $i_rx, 1, "Failed to initialize Ham::APRS::IS");
|
||||
|
||||
my $ret;
|
||||
$ret = $i_tx->connect('retryuntil' => 8);
|
||||
ok($ret, 1, "Failed to connect to the server: " . $i_tx->{'error'});
|
||||
$ret = $i_rx->connect('retryuntil' => 8);
|
||||
ok($ret, 1, "Failed to connect to the server: " . $i_rx->{'error'});
|
||||
|
||||
# do the actual tests
|
||||
|
||||
my $data = 'foo';
|
||||
|
||||
# first, send a packet and see that it goes through
|
||||
istest::txrx(\&ok, $i_tx, $i_rx,
|
||||
"SRC>DST,qAR:$data",
|
||||
"SRC>DST,qAS,$login:$data");
|
||||
|
||||
# send the same packet again and see that it is dropped
|
||||
istest::should_drop(\&ok, $i_tx, $i_rx,
|
||||
"SRC>DST,qAR:$data", # should drop
|
||||
"SRC>DST:dummy", 1); # will pass (helper packet)
|
||||
|
||||
# source callsign should be case sensitive - verify that a lower-case
|
||||
# callsign gets through
|
||||
istest::txrx(\&ok, $i_tx, $i_rx,
|
||||
"src>DST,qAR:$data",
|
||||
"src>DST,qAS,$login:$data");
|
||||
|
||||
# send the same packet with a different digi path and see that it is dropped
|
||||
istest::should_drop(\&ok, $i_tx, $i_rx,
|
||||
"SRC>DST,DIGI1*,qAR:$data", # should drop
|
||||
"SRC>DST:dummy", 1); # will pass (helper packet)
|
||||
|
||||
# send the same packet with a different Q construct and see that it is dropped
|
||||
istest::should_drop(\&ok, $i_tx, $i_rx,
|
||||
"SRC>DST,$login,I:$data", # should drop
|
||||
"SRC>DST:dummy", 1); # will pass (helper packet)
|
||||
|
||||
# send the same packet with additional whitespace in the end, should pass
|
||||
istest::txrx(\&ok, $i_tx, $i_rx,
|
||||
"SRC>DST,$login,I:$data ",
|
||||
"SRC>DST,qAR,$login:$data ");
|
||||
|
||||
# send the same packet with a different destination call, should pass
|
||||
istest::txrx(\&ok, $i_tx, $i_rx,
|
||||
"SRC>DST2,DIGI1*,qAR:$data",
|
||||
"SRC>DST2,DIGI1*,qAS,$login:$data");
|
||||
|
||||
# disconnect
|
||||
|
||||
$ret = $i_rx->disconnect();
|
||||
ok($ret, 1, "Failed to disconnect from the server: " . $i_rx->{'error'});
|
||||
$ret = $i_tx->disconnect();
|
||||
ok($ret, 1, "Failed to disconnect from the server: " . $i_tx->{'error'});
|
||||
|
||||
# stop
|
||||
|
||||
ok($p->stop(), 1, "Failed to stop product");
|
||||
|
||||
Loading…
Reference in New Issue