Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

tests for binary data

Test that we can write+read and write+recv binary data.
  • Loading branch information...
commit 7bcb012a23f39469db66a9e268cf975092ece8b1 1 parent 033cbc9
@FROGGS FROGGS authored
View
48 S32-io/IO-Socket-INET.pl
@@ -177,6 +177,54 @@
}
}
+ # for test 7 and 8
+ my Buf $binary = slurp( 't/spec/S32-io/socket-test.bin', bin => True );
+
+ when 7 { # test number 7 - write/read binary data
+ if $server_or_client eq 'server' {
+ my $server = IO::Socket::INET.new(:localhost($host), :localport($port), :listen);
+ my $fd = open( $server_ready_flag_fn, :w );
+ $fd.close();
+ if my $client = $server.accept() {
+ # send binary data á 4096 bytes
+ $client.write( $binary );
+ $client.close();
+ }
+ }
+ else {
+ until $server_ready_flag_fn.IO ~~ :e { sleep(0.1) }
+ unlink $server_ready_flag_fn;
+ my $sock = IO::Socket::INET.new(:$host, :$port);
+ my $recv = $sock.read( 4096 );
+ say $binary eqv $recv ?? 'OK-7' !! 'NOK-7';
+ $sock.close();
+ }
+ }
+
+ when 8 { # test number 8 - write/recv binary data
+ if $server_or_client eq 'server' {
+ my $server = IO::Socket::INET.new(:localhost($host), :localport($port), :listen);
+ my $fd = open( $server_ready_flag_fn, :w );
+ $fd.close();
+ if my $client = $server.accept() {
+ # send binary data á 4096 bytes
+ $client.write( $binary );
+ $client.close();
+ }
+ }
+ else {
+ until $server_ready_flag_fn.IO ~~ :e { sleep(0.1) }
+ unlink $server_ready_flag_fn;
+ my $sock = IO::Socket::INET.new(:$host, :$port);
+ my Str $recv;
+ my Str $chunk;
+ while $chunk = $sock.recv( 4096 ) {
+ $recv ~= $chunk;
+ }
+ say $binary.decode('binary') eq $recv ?? 'OK-8' !! 'NOK-8';
+ $sock.close();
+ }
+ }
}
=begin pod
View
21 S32-io/IO-Socket-INET.t
@@ -1,7 +1,7 @@
use v6;
use Test;
-plan 19;
+plan 21;
# L<S32::IO/IO::Socket::INET>
@@ -126,6 +126,25 @@ if $*OS eq any <linux darwin solaris MSWin32> { # please add more valid OS names
is $expected[$i++], '0', 'received first character';
is $expected[$i++], '3', 'received last character';
is $expected[$i++], 4096 * 4, 'total amount ';
+
+ # test 7 tests rcv with binary data
+ if $is-win {
+ $received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 7 $port};
+ } else {
+ $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 7 $port};
+ }
+ $expected = $received.split("\n");
+ is $expected[0], 'OK-7', 'successful read binary data';
+
+ # test 8 tests recv with binary data. This test should show that
+ # .recv will fall back to binary when utf-8 decoding fails.
+ if $is-win {
+ $received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 8 $port};
+ } else {
+ $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 8 $port};
+ }
+ $expected = $received.split("\n");
+ is $expected[0], 'OK-8', 'successful received binary data';
}
else {
skip "OS '$*OS' shell support not confirmed", 1;
View
BIN  S32-io/socket-test.bin
Binary file not shown
Please sign in to comment.
Something went wrong with that request. Please try again.