Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 191 lines (164 sloc) 7.03 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
7bcb012 @FROGGS tests for binary data
FROGGS authored
4 plan 21;
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";
1c9a698 @moritz avoid warnings
moritz authored
18 $netstat_pat = rx{ State .+? [ ^^ .+? ':' (\d+) .+? ]+ $ };
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
19 }
20 when 'darwin' {
21 $netstat_cmd = "netstat -f inet -p tcp -a -n";
1c9a698 @moritz avoid warnings
moritz authored
22 $netstat_pat = rx{ [ ^^ .+? '.' (\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";
1c9a698 @moritz avoid warnings
moritz authored
26 $netstat_pat = rx{ [ ^^ .+? '.' (\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";
1c9a698 @moritz avoid warnings
moritz authored
30 $netstat_pat = rx{ 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++; }
15c1b74 @moritz [socket] adapt to more p5 like IO::Socket::INET implementation
moritz authored
47 if $port >= 65535 {
48 diag "no free port; aborting";
2e0ab17 [t/spec] made Socket test a bit more robust
moritz authored
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
d48a181 [t/spec/S32-io] Add batch file and allow these tests to run on Window…
carlin authored
55 if $*OS eq any <linux darwin solaris MSWin32> { # please add more valid OS names
56
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
57 my $is-win;
58 $is-win = True if $*OS eq 'MSWin32';
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
59
60 # test 2 does echo protocol - Internet RFC 862
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
61 if $is-win {
62 $received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 2 $port};
63 } else {
64 $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 2 $port};
65 }
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
66 #warn "TEST 2 $received";
67 $expected = "echo '0123456789abcdefghijklmnopqrstuvwxyz' received\n";
68 is $received, $expected, "echo server and client";
69
70 # test 3 does discard protocol - Internet RFC 863
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
71 if $is-win {
72 $received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 3 $port};
73 } else {
74 $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 3 $port};
75 }
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
76 #warn "TEST 3 $received";
77 $expected = "discard '' received\n";
78 is $received, $expected, "discard server and client";
12cdb6d [t/spec/S32-io] Add (fudged) tests for recv with a parameter
carlin authored
79
80 # test 4 tests recv with a parameter
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 4 $port};
83 } else {
84 $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
85 }
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
86 $expected = $received.split("\n");
12cdb6d [t/spec/S32-io] Add (fudged) tests for recv with a parameter
carlin authored
87 my $i = 0;
88 is $expected[$i++], '0123456', 'received first 7 characters';
89 is $expected[$i++], '789', 'received next 3 characters';
90 is $expected[$i++], 'abcdefghijklmnopqrstuvwxyz', 'remaining 26 were buffered';
91 # Multibyte characters
c07dfde @FROGGS tests for multibyte chars successful
FROGGS authored
92 # RT #115862
3c2dc0e @FROGGS RT #115862, skipping multibyte tests for release
FROGGS authored
93 is $expected[$i], chr(0xbeef), "received {chr 0xbeef}";
94 $i++;
333ca4c @moritz update Socket tests to assume character semantics in .recv
moritz authored
95 is $expected[$i++], 1, '... which is 1 character';
96 is $expected[$i++], 1, 'received another character';
c07dfde @FROGGS tests for multibyte chars successful
FROGGS authored
97 # RT #115862
3c2dc0e @FROGGS RT #115862, skipping multibyte tests for release
FROGGS authored
98 is $expected[$i], chr(0xbabe), "combined the bytes form {chr 0xbabe}";
99 $i++;
096645d [t/spec/S32-io] Add (fudged) tests for IO::Socket.get()
carlin authored
100
101 # test 5 tests get()
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
102 if $is-win {
103 $received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 5 $port};
104 } else {
105 $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
106 }
7554daf [t/spec/S32-io] Fix the indenting and whitespace from my previous commit
carlin authored
107 $expected = $received.split("\n");
096645d [t/spec/S32-io] Add (fudged) tests for IO::Socket.get()
carlin authored
108 $i = 0;
109 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
110 'get() with default separator';
096645d [t/spec/S32-io] Add (fudged) tests for IO::Socket.get()
carlin authored
111 is $expected[$i++], 'Did gyre and gimble in the wabe;', 'default separator';
112 is $expected[$i++], 'All mimsy were the borogoves,', '\r\n separator';
113 is $expected[$i++], 'And the mome raths outgrabe', '. as a separator';
114 is $expected[$i++], 'O frabjous day', '! separator not at end of string';
115 is $expected[$i++], ' Callooh', 'Multiple separators not at end of string';
116 is $expected[$i++], ' Callay', '! separator at end of string';
bbc7541 @FROGGS RT #116288, test that $socket.read will give us the whole cake
FROGGS authored
117
033cbc9 @FROGGS RT #116288, linked ticket to test case
FROGGS authored
118 # RT #116288, test 6 tests read with a parameter
bbc7541 @FROGGS RT #116288, test that $socket.read will give us the whole cake
FROGGS authored
119 if $is-win {
120 $received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 6 $port};
121 } else {
122 $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 6 $port};
123 }
124 $expected = $received.split("\n");
125 $i = 0;
126 is $expected[$i++], '0', 'received first character';
127 is $expected[$i++], '3', 'received last character';
128 is $expected[$i++], 4096 * 4, 'total amount ';
7bcb012 @FROGGS tests for binary data
FROGGS authored
129
130 # test 7 tests rcv with binary data
131 if $is-win {
132 $received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 7 $port};
133 } else {
134 $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 7 $port};
135 }
136 $expected = $received.split("\n");
137 is $expected[0], 'OK-7', 'successful read binary data';
138
139 # test 8 tests recv with binary data. This test should show that
140 # .recv will fall back to binary when utf-8 decoding fails.
141 if $is-win {
142 $received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 8 $port};
143 } else {
144 $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 8 $port};
145 }
146 $expected = $received.split("\n");
147 is $expected[0], 'OK-8', 'successful received binary data';
ba86db9 [t/spec/S32-io/IO-Socket-INET.t] shell script forks client and server
mberends authored
148 }
149 else {
8b5a87e @moritz reverse order of skip() arguments all over the test suite
moritz authored
150 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
151 }
152
153
154 =begin pod
155
156 =head1 Perl 6 Internet Sockets Testing
157 The initial use of the BSD Sockets library by Parrot and Rakudo happened
158 without a formal test suite, slowing development and causing occasional
159 random errors. This set of tests aims to ensure the future stability of
160 of the Sockets library integration, and to help enhance Rakudo's
161 IO::Socket::INET class in the 'setting'.
162
163 The BSD Sockets functions provide server and client functions that run
164 synchronously, blocking and waiting indefinitely for communication from
165 a remote process. Sockets testing therefore requires separate server and
166 client processes or threads. Rakudo does not currently fork or thread,
167 so these tests employ a unix shell script that uses the & symbol to fork
168 background processes. When Rakudo starts forking or threading, this
169 testing solution should be refactored down to just the main script.
170
171 =head1 Scope of tests
172 To date, only single TCP sessions have been tested, and only on Linux.
173 The Internet standard protocols are used, except that a dynamic port
174 number above the first 1024 is used so that superuser (root) privileges
175 are not required. Execution time is 5 to 10 seconds.
176
177 =head1 TODO
178 UDP. Unix sockets. Concurrent connections (needs threads).
179
180 =head1 SEE ALSO
181
182 echo L<http://www.ietf.org/rfc/rfc862.txt> port 7
183 discard L<http://www.ietf.org/rfc/rfc863.txt> port 9
184 chargen L<http://www.ietf.org/rfc/rfc864.txt> port 19
185 daytime L<http://www.ietf.org/rfc/rfc867.txt> port 13
186 time L<http://www.ietf.org/rfc/rfc868.txt> port 37
187
188 =end pod
2e0ab17 [t/spec] made Socket test a bit more robust
moritz authored
189
190 # vim: ft=perl6
Something went wrong with that request. Please try again.