| 1 | #!./perl |
| 2 | |
| 3 | # Check for presence and correctness of .ph files; for now, |
| 4 | # just socket.ph and pals. |
| 5 | # -- Kurt Starsinic <kstar@isinet.com> |
| 6 | |
| 7 | BEGIN { |
| 8 | chdir 't' if -d 't'; |
| 9 | @INC = '../lib'; |
| 10 | } |
| 11 | |
| 12 | # All the constants which Socket.pm tries to make available: |
| 13 | my @possibly_defined = qw( |
| 14 | INADDR_ANY INADDR_LOOPBACK INADDR_NONE AF_802 AF_APPLETALK AF_CCITT |
| 15 | AF_CHAOS AF_DATAKIT AF_DECnet AF_DLI AF_ECMA AF_GOSIP AF_HYLINK AF_IMPLINK |
| 16 | AF_INET AF_LAT AF_MAX AF_NBS AF_NIT AF_NS AF_OSI AF_OSINET AF_PUP |
| 17 | AF_SNA AF_UNIX AF_UNSPEC AF_X25 MSG_DONTROUTE MSG_MAXIOVLEN MSG_OOB |
| 18 | MSG_PEEK PF_802 PF_APPLETALK PF_CCITT PF_CHAOS PF_DATAKIT PF_DECnet PF_DLI |
| 19 | PF_ECMA PF_GOSIP PF_HYLINK PF_IMPLINK PF_INET PF_LAT PF_MAX PF_NBS PF_NIT |
| 20 | PF_NS PF_OSI PF_OSINET PF_PUP PF_SNA PF_UNIX PF_UNSPEC PF_X25 SOCK_DGRAM |
| 21 | SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM SOL_SOCKET SOMAXCONN |
| 22 | SO_ACCEPTCONN SO_BROADCAST SO_DEBUG SO_DONTLINGER SO_DONTROUTE SO_ERROR |
| 23 | SO_KEEPALIVE SO_LINGER SO_OOBINLINE SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO |
| 24 | SO_REUSEADDR SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO SO_TYPE SO_USELOOPBACK |
| 25 | ); |
| 26 | |
| 27 | |
| 28 | # The libraries which I'm going to require: |
| 29 | my @libs = qw(Socket "sys/types.ph" "sys/socket.ph" "netinet/in.ph"); |
| 30 | |
| 31 | |
| 32 | # These are defined by Socket.pm even if the C header files don't define them: |
| 33 | my %ok_to_miss = ( |
| 34 | INADDR_NONE => 1, |
| 35 | INADDR_LOOPBACK => 1, |
| 36 | ); |
| 37 | |
| 38 | |
| 39 | my $total_tests = scalar @libs + scalar @possibly_defined; |
| 40 | my $i = 0; |
| 41 | |
| 42 | print "1..$total_tests\n"; |
| 43 | |
| 44 | |
| 45 | foreach (@libs) { |
| 46 | $i++; |
| 47 | |
| 48 | if (eval "require $_" ) { |
| 49 | print "ok $i\n"; |
| 50 | } else { |
| 51 | print "# Skipping tests; $_ may be missing\n"; |
| 52 | foreach ($i .. $total_tests) { print "ok $_\n" } |
| 53 | exit; |
| 54 | } |
| 55 | } |
| 56 | |
| 57 | |
| 58 | foreach (@possibly_defined) { |
| 59 | $i++; |
| 60 | |
| 61 | $pm_val = eval "Socket::$_()"; |
| 62 | $ph_val = eval "main::$_()"; |
| 63 | |
| 64 | if (defined $pm_val and !defined $ph_val) { |
| 65 | if ($ok_to_miss{$_}) { print "ok $i\n" } |
| 66 | else { print "not ok $i\n" } |
| 67 | next; |
| 68 | } elsif (defined $ph_val and !defined $pm_val) { |
| 69 | print "not ok $i\n"; |
| 70 | next; |
| 71 | } |
| 72 | |
| 73 | # Socket.pm converts these to network byte order, so we convert the |
| 74 | # socket.ph version to match; note that these cases skip the following |
| 75 | # `elsif', which is only applied to _numeric_ values, not literal |
| 76 | # bitmasks. |
| 77 | if ($_ eq 'INADDR_ANY' |
| 78 | or $_ eq 'INADDR_LOOPBACK' |
| 79 | or $_ eq 'INADDR_NONE') { |
| 80 | $ph_val = pack("N*", $ph_val); # htonl(3) equivalent |
| 81 | } |
| 82 | |
| 83 | # Since Socket.pm and socket.ph wave their hands over macros differently, |
| 84 | # they could return functionally equivalent bitmaps with different numeric |
| 85 | # interpretations (due to sign extension). The only apparent case of this |
| 86 | # is SO_DONTLINGER (only on Solaris, and deprecated, at that): |
| 87 | elsif ($pm_val != $ph_val) { |
| 88 | $pm_val = oct(sprintf "0x%lx", $pm_val); |
| 89 | $ph_val = oct(sprintf "0x%lx", $ph_val); |
| 90 | } |
| 91 | |
| 92 | if ($pm_val == $ph_val) { print "ok $i\n" } |
| 93 | else { print "not ok $i\n" } |
| 94 | } |
| 95 | |
| 96 | |