From 60a0142c6e799ce1cf1518feac0a014c65dc4377 Mon Sep 17 00:00:00 2001 From: Heikki Hannikainen Date: Thu, 28 Jun 2012 06:44:00 +0000 Subject: [PATCH] Added test cases for heavier packet load (very crude benchmark test), larger blobs of packets getting truncated, and packet without CRLF in the end followed by a disconnect getting passed. git-svn-id: http://repo.ham.fi/svn/aprsc/trunk@474 3ce903b1-3385-4e86-93cd-f9a4a239f7ac --- tests/t/50disc-blobs.t | 87 +++++++++++++++++++++++++++++++ tests/t/51load.t | 114 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 201 insertions(+) create mode 100644 tests/t/50disc-blobs.t create mode 100644 tests/t/51load.t diff --git a/tests/t/50disc-blobs.t b/tests/t/50disc-blobs.t new file mode 100644 index 0000000..dafe790 --- /dev/null +++ b/tests/t/50disc-blobs.t @@ -0,0 +1,87 @@ + +# +# Test disconnection in the middle of transmitting a packet +# + +use Test; +BEGIN { plan tests => 12 }; +use runproduct; +use istest; +use Ham::APRS::IS; + +my $p = new runproduct('basic'); + +ok(defined $p, 1, "Failed to initialize product runner"); +ok($p->start(), 1, "Failed to start product"); + +my $login_tx = "N0GAT"; +my $i_tx = new Ham::APRS::IS("localhost:55580", $login_tx); +ok(defined $i_tx, 1, "Failed to initialize Ham::APRS::IS"); + +my $login_rx = "N1GAT"; +my $i_rx = new Ham::APRS::IS("localhost:55152", $login_rx); +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'}); + +# Send a packet halfway and disconnect +my $tx = "M0SRC>APRS,OH2RDG*,WIDE,qAR,$login_tx:!6028.51N/02505.68E#this packet trunca"; +$i_tx->sendline($tx, 1); +sleep(1); +$i_tx->disconnect(); + +my $r = $i_rx->getline_noncomment(2); +ok($r, undef, "Got message without CRLF truncated due to disconnect"); + +# connect again + +$ret = $i_tx->connect('retryuntil' => 8); +ok($ret, 1, "Failed to connect to the server: " . $i_tx->{'error'}); + +# +############################################ +# Do a blob transmit test +# + +my $blobsize = 32*1024; +$tx = ''; +my $txl = 0; +my $txn = 0; +my @l = (); + +while ($txl < $blobsize) { + $s = "M" . ($txn + 10) . ">APRS,qAR,$login_tx:!6028.51N/02505.68E#should pass blaa blaa blaa blaa blaa blaa blaa blaa blaa blaa END"; + push @l, $s; + $tx .= $s . "\r\n";; + $txl += length($s); + $txn++; +} + +warn " blobsize $txl ($blobsize) with $txn packets\n"; + +my $sent = $i_tx->sendline($tx, 1); +ok($sent, 1, "Failed to transmit blob of $txl bytes"); + +my $rxl = 0; +my $rxn = 0; +while (my $rx = $i_rx->getline_noncomment(1)) { + if ($rx ne $l[$rxn]) { + warn "got wrong packet: $rx\n"; + } + $rxn++; + $rxl += length($rx); +} + +ok($rxn, $txn, "Received wrong number of lines from blob"); +ok($rxl, $txl, "Received wrong number of bytes from blob"); + + +# stop + +ok($p->stop(), 1, "Failed to stop product"); + diff --git a/tests/t/51load.t b/tests/t/51load.t new file mode 100644 index 0000000..e5aaa27 --- /dev/null +++ b/tests/t/51load.t @@ -0,0 +1,114 @@ + +# +# Test heavier packet load +# + +use Test; +BEGIN { plan tests => 10 }; +use runproduct; +use Ham::APRS::IS; +use Time::HiRes qw( sleep time ); + +my $p = new runproduct('basic'); + +ok(defined $p, 1, "Failed to initialize product runner"); +ok($p->start(), 1, "Failed to start product"); + +my $login_tx = "N0GAT"; +my $i_tx = new Ham::APRS::IS("localhost:55580", $login_tx); +ok(defined $i_tx, 1, "Failed to initialize Ham::APRS::IS"); + +my $login_rx = "N1GAT"; +my $i_rx = new Ham::APRS::IS("localhost:55152", $login_rx); +ok(defined $i_rx, 1, "Failed to initialize Ham::APRS::IS"); + +$ret = $i_rx->connect('retryuntil' => 8); +ok($ret, 1, "Failed to connect to the server: " . $i_rx->{'error'}); + +my $ret; +$ret = $i_tx->connect('retryuntil' => 8); +ok($ret, 1, "Failed to connect to the server: " . $i_tx->{'error'}); + +# let it get started +sleep(0.5); + +############################################ + +my $flush_interval = 300; +my $bytelimit = 4*1024*1024; +my $window = 64*1024; +#my $window = 4*1024; +my $outstanding = 0; +my $txn = 0; +my $rxn = 0; +my $txl = 0; +my $rxl = 0; +my @l = (); +my $txq = ''; +my $txq_l = 0; + +my $start_t = time(); + +while ($txl < $bytelimit) { + $s = "M" . ($txn % 10000 + 10) . ">APRS,qAR,$login_tx:!6028.51N/02505.68E# packet $txn blaa blaa blaa blaa END"; + push @l, $s; + $s .= "\r\n"; + my $sl = length($s); + $txl += $sl; + $txq_l += $sl; + $txq .= $s; + $txn++; + + if ($txq_l >= $flush_interval) { + $i_tx->sendline($txq, 1); + $outstanding += $txq_l; + $txq_l = 0; + $txq = ''; + } + + while (($outstanding > $window) && (my $rx = $i_rx->getline_noncomment(0))) { + my $exp = shift @l; + if ($exp ne $rx) { + warn "Ouch, received wrong packet: $rx\n"; + } + my $rx_l = length($rx) + 2; + $outstanding -= $rx_l; + $rxn++; + $rxl += $rx_l; + } +} + +if ($txq_l > 0) { + warn "flushing the rest\n"; + $i_tx->sendline($txq, 1); + $outstanding += $txq_l; + $txq_l = 0; + $txq = 0; +} + +warn "reading the rest, have received $rxn packets, sent $txn\n"; +while (($outstanding > 0) && (my $rx = $i_rx->getline_noncomment(0.5))) { + my $exp = shift @l; + if ($exp ne $rx) { + warn "Ouch, received wrong packet: $rx\n"; + } + my $rx_l = length($rx) + 2; + $outstanding -= $rx_l; + $rxn++; + $rxl += $rx_l; +} +warn "after reading the rest, have received $rxn packets, sent $txn, outstanding $outstanding bytes\n"; + +$end_t = time(); +$dur_t = $end_t - $start_t; + +warn sprintf("took %.3f seconds, %.0f packets/sec\n", $dur_t, $rxn / $dur_t); + +ok($rxn, $txn, "Received wrong number of lines from blob"); +ok($rxl, $txl, "Received wrong number of bytes from blob"); +ok($outstanding, 0, "There are outstanding bytes in the server after timeout"); + +# stop + +ok($p->stop(), 1, "Failed to stop product"); +