Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 190 lines (163 sloc) 6.94 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
a793f13 @FROGGS expect .recv( bin => True ) to return Buf
FROGGS authored
130 # test 7 tests recv with binary data
7bcb012 @FROGGS tests for binary data
FROGGS authored
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
a793f13 @FROGGS expect .recv( bin => True ) to return Buf
FROGGS authored
139 # test 8 tests recv with binary data.
7bcb012 @FROGGS tests for binary data
FROGGS authored
140 if $is-win {
141 $received = qqx{t\\spec\\S32-io\\IO-Socket-INET.bat 8 $port};
142 } else {
143 $received = qqx{sh t/spec/S32-io/IO-Socket-INET.sh 8 $port};
144 }
145 $expected = $received.split("\n");
146 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
147 }
148 else {
8b5a87e @moritz reverse order of skip() arguments all over the test suite
moritz authored
149 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
150 }
151
152
153 =begin pod
154
155 =head1 Perl 6 Internet Sockets Testing
156 The initial use of the BSD Sockets library by Parrot and Rakudo happened
157 without a formal test suite, slowing development and causing occasional
158 random errors. This set of tests aims to ensure the future stability of
159 of the Sockets library integration, and to help enhance Rakudo's
160 IO::Socket::INET class in the 'setting'.
161
162 The BSD Sockets functions provide server and client functions that run
163 synchronously, blocking and waiting indefinitely for communication from
164 a remote process. Sockets testing therefore requires separate server and
165 client processes or threads. Rakudo does not currently fork or thread,
166 so these tests employ a unix shell script that uses the & symbol to fork
167 background processes. When Rakudo starts forking or threading, this
168 testing solution should be refactored down to just the main script.
169
170 =head1 Scope of tests
171 To date, only single TCP sessions have been tested, and only on Linux.
172 The Internet standard protocols are used, except that a dynamic port
173 number above the first 1024 is used so that superuser (root) privileges
174 are not required. Execution time is 5 to 10 seconds.
175
176 =head1 TODO
177 UDP. Unix sockets. Concurrent connections (needs threads).
178
179 =head1 SEE ALSO
180
181 echo L<http://www.ietf.org/rfc/rfc862.txt> port 7
182 discard L<http://www.ietf.org/rfc/rfc863.txt> port 9
183 chargen L<http://www.ietf.org/rfc/rfc864.txt> port 19
184 daytime L<http://www.ietf.org/rfc/rfc867.txt> port 13
185 time L<http://www.ietf.org/rfc/rfc868.txt> port 37
186
187 =end pod
2e0ab17 [t/spec] made Socket test a bit more robust
moritz authored
188
189 # vim: ft=perl6
Something went wrong with that request. Please try again.