Skip to content
Newer
Older
100644 168 lines (144 sloc) 6.37 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
096645d [t/spec/S32-io] Add (fudged) tests for IO::Socket.get()
carlin authored
4 plan 18;
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
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 }
1f02366 [t/spec/S32-io] Make these tests run on solaris, confirmed passing
carlin authored
24 when 'solaris' {
25 $netstat_cmd = "netstat -an -P tcp -f inet";
d48a181 [t/spec/S32-io] Add batch file and allow these tests to run on Window…
carlin authored
26 $netstat_pat = regex { [ ^^ .+? '.' (\d+) ' ' .+? ]+ $ }; # same as darwin
1f02366 [t/spec/S32-io] Make these tests run on solaris, confirmed passing
carlin authored
27 }
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
28 when 'MSWin32' {
29 $netstat_cmd = "netstat -n";
d48a181 [t/spec/S32-io] Add batch file and allow these tests to run on Window…
carlin authored
30 $netstat_pat = regex { State .+? [ ^^ .+? ':' (\d+) .+? ]+ $ }; # same as linux
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
31 }
2e0ab17 [t/spec] made Socket test a bit more robust
moritz authored
32 default {
33 skip_rest('Operating system not yet supported');
34 exit 0;
35 }
e7439a1 [t/spec/S32-io] Remove/update some comments
carlin authored
36 # TODO: other operating systems; *BSD etc.
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
37 }
4753f03 fixed a bug in t/S32-io/IO-Socket-INET.t etc where an impatient timeout
mberends authored
38 $received = qqx{$netstat_cmd}; # refactor into 1 line after
a15591d [S32-io/IO-Socket-INET.t,.pl] Rakudo fudge 15 tests that alpha passes…
mberends authored
39 if $received ~~ $netstat_pat { @ports = $/.list; } # development complete
40 # was @ports = $/[] in Rakudo/alpha
41 # @ports = $/[0] also now in master
04afe09 [IO-Socket-INET.t] remove developer scaffolding
mberends authored
42 #warn @ports.elems ~ " PORTS=" ~ @ports;
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
43
44 # sequentially search for the first unused port
45 my $port = 1024;
46 while $port < 65535 && $port==any(@ports) { $port++; }
a15591d [S32-io/IO-Socket-INET.t,.pl] Rakudo fudge 15 tests that alpha passes…
mberends authored
47 if $port > 65535 {
2e0ab17 [t/spec] made Socket test a bit more robust
moritz authored
48 diag "no free port; abortin";
49 skip_rest 'No port free - cannot test';
50 exit 0;
51 }
52 diag "Testing on port $port";
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
53
54 # test 1 creates a TCP socket but does not use it.
a15591d [S32-io/IO-Socket-INET.t,.pl] Rakudo fudge 15 tests that alpha passes…
mberends authored
55 # use Perl 5 style subs for constants until 'constant' works again
56 sub PF_INET { 2 } # constant PF_INET = 2; # these should move into a file,
57 sub SOCK_STREAM { 1 } # constant SOCK_STREAM = 1; # but what name and directory?
58 sub TCP { 6 } # constant TCP = 6;
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
59 my $server = IO::Socket::INET.socket( PF_INET, SOCK_STREAM, TCP );
60 isa_ok $server, IO::Socket::INET;
61 # Do not bind to this socket in the parent process, that would prevent a
62 # child process from using it.
63
d48a181 [t/spec/S32-io] Add batch file and allow these tests to run on Window…
carlin authored
64 if $*OS eq any <linux darwin solaris MSWin32> { # please add more valid OS names
65
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
66 my $is-win;
67 $is-win = True if $*OS eq 'MSWin32';
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
68
69 # test 2 does echo protocol - Internet RFC 862
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
70 if $is-win {
71 $received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 2 $port};
72 } else {
73 $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 2 $port};
74 }
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
75 #warn "TEST 2 $received";
76 $expected = "echo '0123456789abcdefghijklmnopqrstuvwxyz' received\n";
bc3da13 @masak [S02, S32] fudged tests TODO for Rakudo
masak authored
77 #?rakudo todo 'Test fails fairly consistently on at least darwin'
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
78 is $received, $expected, "echo server and client";
79
80 # test 3 does discard protocol - Internet RFC 863
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
81 if $is-win {
82 $received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 3 $port};
83 } else {
84 $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 3 $port};
85 }
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
86 #warn "TEST 3 $received";
87 $expected = "discard '' received\n";
88 is $received, $expected, "discard server and client";
12cdb6d [t/spec/S32-io] Add (fudged) tests for recv with a parameter
carlin authored
89
90 # test 4 tests recv with a parameter
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
91 if $is-win {
92 $received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 4 $port};
93 } else {
94 $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 4 $port};
d48a181 [t/spec/S32-io] Add batch file and allow these tests to run on Window…
carlin authored
95 }
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
96 $expected = $received.split("\n");
12cdb6d [t/spec/S32-io] Add (fudged) tests for recv with a parameter
carlin authored
97 my $i = 0;
98 is $expected[$i++], '0123456', 'received first 7 characters';
99 is $expected[$i++], '789', 'received next 3 characters';
100 is $expected[$i++], 'abcdefghijklmnopqrstuvwxyz', 'remaining 26 were buffered';
101 # Multibyte characters
102 is $expected[$i++], chr(0xbeef), "received {chr 0xbeef}";
103 is $expected[$i++], 3, '... which is 3 bytes';
104 is $expected[$i++], 2, 'received 2 bytes of a 3 byte unicode character';
105 is $expected[$i++], chr(0xbabe), "combined the bytes form {chr 0xbabe}";
106 is $expected[$i++], 3, '... which is 3 bytes';
096645d [t/spec/S32-io] Add (fudged) tests for IO::Socket.get()
carlin authored
107
108 #?rakudo 7 skip
109 # test 5 tests get()
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
110 if $is-win {
111 $received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 5 $port};
112 } else {
113 $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 5 $port};
d48a181 [t/spec/S32-io] Add batch file and allow these tests to run on Window…
carlin authored
114 }
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
115 $expected = $received.split("\n");
096645d [t/spec/S32-io] Add (fudged) tests for IO::Socket.get()
carlin authored
116 $i = 0;
117 is $expected[$i++], "'Twas brillig, and the slithy toves",
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
118 'get() with default separator';
096645d [t/spec/S32-io] Add (fudged) tests for IO::Socket.get()
carlin authored
119 is $expected[$i++], 'Did gyre and gimble in the wabe;', 'default separator';
120 is $expected[$i++], 'All mimsy were the borogoves,', '\r\n separator';
121 is $expected[$i++], 'And the mome raths outgrabe', '. as a separator';
122 is $expected[$i++], 'O frabjous day', '! separator not at end of string';
123 is $expected[$i++], ' Callooh', 'Multiple separators not at end of string';
124 is $expected[$i++], ' Callay', '! separator at end of string';
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
125 }
126 else {
8b5a87e @moritz reverse order of skip() arguments all over the test suite
moritz authored
127 skip "OS '$*OS' shell support not confirmed", 1;
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
128 }
129
130
131 =begin pod
132
133 =head1 Perl 6 Internet Sockets Testing
134 The initial use of the BSD Sockets library by Parrot and Rakudo happened
135 without a formal test suite, slowing development and causing occasional
136 random errors. This set of tests aims to ensure the future stability of
137 of the Sockets library integration, and to help enhance Rakudo's
138 IO::Socket::INET class in the 'setting'.
139
140 The BSD Sockets functions provide server and client functions that run
141 synchronously, blocking and waiting indefinitely for communication from
142 a remote process. Sockets testing therefore requires separate server and
143 client processes or threads. Rakudo does not currently fork or thread,
144 so these tests employ a unix shell script that uses the & symbol to fork
145 background processes. When Rakudo starts forking or threading, this
146 testing solution should be refactored down to just the main script.
147
148 =head1 Scope of tests
149 To date, only single TCP sessions have been tested, and only on Linux.
150 The Internet standard protocols are used, except that a dynamic port
151 number above the first 1024 is used so that superuser (root) privileges
152 are not required. Execution time is 5 to 10 seconds.
153
154 =head1 TODO
155 UDP. Unix sockets. Concurrent connections (needs threads).
156
157 =head1 SEE ALSO
158
159 echo L<http://www.ietf.org/rfc/rfc862.txt> port 7
160 discard L<http://www.ietf.org/rfc/rfc863.txt> port 9
161 chargen L<http://www.ietf.org/rfc/rfc864.txt> port 19
162 daytime L<http://www.ietf.org/rfc/rfc867.txt> port 13
163 time L<http://www.ietf.org/rfc/rfc868.txt> port 37
164
165 =end pod
2e0ab17 [t/spec] made Socket test a bit more robust
moritz authored
166
167 # vim: ft=perl6
Something went wrong with that request. Please try again.