Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 110 lines (89 sloc) 3.931 kb
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
1 use v6;
2 use Test;
3
4 plan 3;
5
820912f [t/spec] more smartlinks; less than 100 remain without smartlinks
moritz authored
6 # L<S32::IO/IO::Socket::INET>
7
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
8 # Testing socket must solve 2 problems: find an unused port to bind to,
9 # and fork a client process before the server is blocked in accept().
10
11 my $host = '127.0.0.1'; # or 'localhost' may be friendlier
12
13 # To find an free port, list the ports currently in use.
db10870 [t/spec] patching difficulties spotted by STD
lwall authored
14 my ( @ports, $netstat_cmd, $netstat_pat, $received, $expected );
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
15 given $*OS {
16 when 'linux' {
17 $netstat_cmd = "netstat --tcp --all --numeric";
18 $netstat_pat = regex { State .+? [ ^^ .+? ':' (\d+) .+? ]+ $ };
19 }
20 when 'darwin' {
21 $netstat_cmd = "netstat -f inet -p tcp -a -n";
ef74167 [t/spec] remove old regexp <sp>, colomon++
moritz authored
22 $netstat_pat = regex { [ ^^ .+? '.' (\d+) ' ' .+? ]+ $ };
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
23 }
2e0ab17 [t/spec] made Socket test a bit more robust
moritz authored
24 default {
25 skip_rest('Operating system not yet supported');
26 exit 0;
27 }
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
28 # TODO: when 'Win32' etc.
29 }
4753f03 fixed a bug in t/S32-io/IO-Socket-INET.t etc where an impatient timeout
mberends authored
30 $received = qqx{$netstat_cmd}; # refactor into 1 line after
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
31 if $received ~~ $netstat_pat { @ports = $/[]; } # development complete
04afe09 [IO-Socket-INET.t] remove developer scaffolding
mberends authored
32 #warn @ports.elems ~ " PORTS=" ~ @ports;
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
33
34 # sequentially search for the first unused port
35 my $port = 1024;
36 while $port < 65535 && $port==any(@ports) { $port++; }
2e0ab17 [t/spec] made Socket test a bit more robust
moritz authored
37 if $port > 65535 {
38 diag "no free port; abortin";
39 skip_rest 'No port free - cannot test';
40 exit 0;
41 }
42 diag "Testing on port $port";
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
43
44 # test 1 creates a TCP socket but does not use it.
45 constant PF_INET = 2; # these should move into a file,
46 constant SOCK_STREAM = 1; # but what name and directory?
47 constant TCP = 6;
48 my $server = IO::Socket::INET.socket( PF_INET, SOCK_STREAM, TCP );
49 isa_ok $server, IO::Socket::INET;
50 # Do not bind to this socket in the parent process, that would prevent a
51 # child process from using it.
52
53 if $*OS eq any <linux darwin> { # please add more valid OS names
54
55 # test 2 does echo protocol - Internet RFC 862
4753f03 fixed a bug in t/S32-io/IO-Socket-INET.t etc where an impatient timeout
mberends authored
56 $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 2 $port};
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
57 #warn "TEST 2 $received";
58 $expected = "echo '0123456789abcdefghijklmnopqrstuvwxyz' received\n";
59 is $received, $expected, "echo server and client";
60
61 # test 3 does discard protocol - Internet RFC 863
4753f03 fixed a bug in t/S32-io/IO-Socket-INET.t etc where an impatient timeout
mberends authored
62 $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 3 $port};
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
63 #warn "TEST 3 $received";
64 $expected = "discard '' received\n";
65 is $received, $expected, "discard server and client";
66 }
67 else {
68 # eg Win32 shell script needs writing
69 skip 1, "OS '$*OS' shell support not confirmed";
70 }
71
72
73 =begin pod
74
75 =head1 Perl 6 Internet Sockets Testing
76 The initial use of the BSD Sockets library by Parrot and Rakudo happened
77 without a formal test suite, slowing development and causing occasional
78 random errors. This set of tests aims to ensure the future stability of
79 of the Sockets library integration, and to help enhance Rakudo's
80 IO::Socket::INET class in the 'setting'.
81
82 The BSD Sockets functions provide server and client functions that run
83 synchronously, blocking and waiting indefinitely for communication from
84 a remote process. Sockets testing therefore requires separate server and
85 client processes or threads. Rakudo does not currently fork or thread,
86 so these tests employ a unix shell script that uses the & symbol to fork
87 background processes. When Rakudo starts forking or threading, this
88 testing solution should be refactored down to just the main script.
89
90 =head1 Scope of tests
91 To date, only single TCP sessions have been tested, and only on Linux.
92 The Internet standard protocols are used, except that a dynamic port
93 number above the first 1024 is used so that superuser (root) privileges
94 are not required. Execution time is 5 to 10 seconds.
95
96 =head1 TODO
97 UDP. Unix sockets. Concurrent connections (needs threads).
98
99 =head1 SEE ALSO
100
101 echo L<http://www.ietf.org/rfc/rfc862.txt> port 7
102 discard L<http://www.ietf.org/rfc/rfc863.txt> port 9
103 chargen L<http://www.ietf.org/rfc/rfc864.txt> port 19
104 daytime L<http://www.ietf.org/rfc/rfc867.txt> port 13
105 time L<http://www.ietf.org/rfc/rfc868.txt> port 37
106
107 =end pod
2e0ab17 [t/spec] made Socket test a bit more robust
moritz authored
108
109 # vim: ft=perl6
Something went wrong with that request. Please try again.