Commit | Line | Data |
---|---|---|
37120919 AD |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
93430cb4 | 5 | unshift @INC, '../lib' if -d '../lib'; |
37120919 | 6 | require Config; import Config; |
c07a80fd | 7 | if ($Config{'extensions'} !~ /\bSocket\b/ && |
3149255e | 8 | !(($^O eq 'VMS') && $Config{d_socket})) { |
2af9ad4a | 9 | print "1..0\n"; |
37120919 AD |
10 | exit 0; |
11 | } | |
12 | } | |
13 | ||
14 | use Socket; | |
15 | ||
ee8c7f54 | 16 | print "1..8\n"; |
37120919 AD |
17 | |
18 | if (socket(T,PF_INET,SOCK_STREAM,6)) { | |
19 | print "ok 1\n"; | |
20 | ||
21 | if (connect(T,pack_sockaddr_in(7,inet_aton("localhost")))){ | |
22 | print "ok 2\n"; | |
23 | ||
24 | print "# Connected to ", | |
25 | inet_ntoa((unpack_sockaddr_in(getpeername(T)))[1]),"\n"; | |
26 | ||
27 | syswrite(T,"hello",5); | |
962dce22 | 28 | $read = sysread(T,$buff,10); # Connection may be granted, then closed! |
d6831368 SB |
29 | while ($read > 0 && length($buff) < 5) { |
30 | # adjust for fact that TCP doesn't guarantee size of reads/writes | |
31 | $read = sysread(T,$buff,10,length($buff)); | |
32 | } | |
962dce22 | 33 | print(($read == 0 || $buff eq "hello") ? "ok 3\n" : "not ok 3\n"); |
37120919 AD |
34 | } |
35 | else { | |
36 | print "# You're allowed to fail tests 2 and 3 if.\n"; | |
37 | print "# The echo service has been disabled.\n"; | |
38 | print "# $!\n"; | |
39 | print "ok 2\n"; | |
40 | print "ok 3\n"; | |
41 | } | |
42 | } | |
43 | else { | |
44 | print "# $!\n"; | |
45 | print "not ok 1\n"; | |
46 | } | |
47 | ||
48 | if( socket(S,PF_INET,SOCK_STREAM,6) ){ | |
49 | print "ok 4\n"; | |
50 | ||
51 | if (connect(S,pack_sockaddr_in(7,INADDR_LOOPBACK))){ | |
52 | print "ok 5\n"; | |
53 | ||
54 | print "# Connected to ", | |
55 | inet_ntoa((unpack_sockaddr_in(getpeername(S)))[1]),"\n"; | |
56 | ||
57 | syswrite(S,"olleh",5); | |
962dce22 | 58 | $read = sysread(S,$buff,10); # Connection may be granted, then closed! |
d6831368 SB |
59 | while ($read > 0 && length($buff) < 5) { |
60 | # adjust for fact that TCP doesn't guarantee size of reads/writes | |
61 | $read = sysread(S,$buff,10,length($buff)); | |
62 | } | |
962dce22 | 63 | print(($read == 0 || $buff eq "olleh") ? "ok 6\n" : "not ok 6\n"); |
37120919 AD |
64 | } |
65 | else { | |
66 | print "# You're allowed to fail tests 5 and 6 if.\n"; | |
67 | print "# The echo service has been disabled.\n"; | |
68 | print "# $!\n"; | |
69 | print "ok 5\n"; | |
70 | print "ok 6\n"; | |
71 | } | |
72 | } | |
73 | else { | |
74 | print "# $!\n"; | |
75 | print "not ok 4\n"; | |
76 | } | |
ee8c7f54 CB |
77 | |
78 | # warnings | |
79 | $SIG{__WARN__} = sub { | |
80 | ++ $w if $_[0] =~ /^6-ARG sockaddr_in call is deprecated/ ; | |
81 | } ; | |
82 | $w = 0 ; | |
83 | sockaddr_in(1,2,3,4,5,6) ; | |
84 | print ($w == 1 ? "not ok 7\n" : "ok 7\n") ; | |
85 | use warnings 'Socket' ; | |
86 | sockaddr_in(1,2,3,4,5,6) ; | |
87 | print ($w == 1 ? "ok 8\n" : "not ok 8\n") ; |