This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Socket to CPAN version 1.98
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Thu, 16 Feb 2012 16:28:35 +0000 (16:28 +0000)
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Fri, 17 Feb 2012 16:57:52 +0000 (16:57 +0000)
  [DELTA]

  1.98  CHANGES:
         * Detect presence of sockaddr_in6 and ipv6_mreq; conditionally build
           pack/unpack functions on this
         * Back-compatibility improvements for older perls, back as far as
           5.6.1 (thanks Zefram)
         * Fix for picky compilers or platforms on which size_t doesn't
           printf() correctly by %d
         * Suppress some harmless compile-time warnings about unused variables

MANIFEST
Porting/Maintainers.pl
cpan/Socket/Makefile.PL
cpan/Socket/Socket.pm
cpan/Socket/Socket.xs
cpan/Socket/t/Socket.t
cpan/Socket/t/socketpair.t
cpan/Socket/typemap [new file with mode: 0644]
pod/perldelta.pod

index 903cda9..0b0e226 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2219,6 +2219,7 @@ cpan/Socket/t/getnameinfo.t               See if Socket::getnameinfo works
 cpan/Socket/t/ipv6_mreq.t              See if (un)pack_ipv6_mreq work
 cpan/Socket/t/socketpair.t             See if socketpair works
 cpan/Socket/t/Socket.t                 See if Socket works
+cpan/Socket/typemap
 cpan/Sys-Syslog/Changes                        Changelog for Sys::Syslog
 cpan/Sys-Syslog/fallback/const-c.inc   Sys::Syslog constants fallback file
 cpan/Sys-Syslog/fallback/const-xs.inc  Sys::Syslog constants fallback file
index b11bd09..eeda629 100755 (executable)
@@ -1615,7 +1615,7 @@ use File::Glob qw(:case);
 
     'Socket' => {
         'MAINTAINER'   => 'pevans',
-        'DISTRIBUTION' => 'PEVANS/Socket-1.97.tar.gz',
+        'DISTRIBUTION' => 'PEVANS/Socket-1.98.tar.gz',
         'FILES'        => q[cpan/Socket],
         'UPSTREAM'     => 'cpan',
     },
index 43cc833..ed6c210 100644 (file)
@@ -36,6 +36,8 @@ sub check_for
 #include <arpa/inet.h>
 int main(int argc, char *argv[])
   {
+    (void)argc;
+    (void)argv;
     $main
     return 0;
   }
@@ -62,7 +64,7 @@ sub check_for_func
 {
     my %args = @_;
     my $func = delete $args{func};
-    check_for( %args, main => "void *p = &$func;" );
+    check_for( %args, main => "void *p = &$func; (void)p;" );
 }
 
 my %defines = (
@@ -90,11 +92,23 @@ check_for(
 );
 
 check_for(
+    confkey => "d_sockaddr_in6", # invented - check with core later
+    define  => "HAS_SOCKADDR_IN6",
+    main    => "struct sockaddr_in6 sin6; sin6.sin6_family = AF_INET6;"
+);
+
+check_for(
     confkey => "d_sin6_scope_id",
     define  => "HAS_SIN6_SCOPE_ID",
     main    => "struct sockaddr_in6 sin6; sin6.sin6_scope_id = 0;"
 );
 
+check_for(
+    confkey => "d_ipv6_mreq", # invented - check with core later
+    define  => "HAS_IPV6_MREQ",
+    main    => "struct ipv6_mreq mreq; mreq.ipv6mr_interface = 0;"
+);
+
 my %makefile_args;
 
 # Since we're providing a later version of a core module, before 5.12 the
@@ -112,6 +126,7 @@ WriteMakefile(
        'ExtUtils::CBuilder' => 0,
        'ExtUtils::Constant' => '0.23',
     },
+    MIN_PERL_VERSION => '5.006001',
     %makefile_args,
 );
 my @names = (
@@ -209,6 +224,15 @@ push @names, {
     value => "newSVpvn_flags((char *)&ip6_address,sizeof(ip6_address), SVs_TEMP)",
 } foreach qw(IN6ADDR_ANY IN6ADDR_LOOPBACK);
 
+# Work around an old Perl core bug that affects ExtUtils::Constants on
+# pre-5.8.2 Perls.  EU:C should be amended to work around this itself.
+if("$]" < 5.008002) {
+    require ExtUtils::Constant::ProxySubs;
+    no warnings "once";
+    $ExtUtils::Constant::ProxySubs::type_to_C_value{$_} = sub { () }
+        foreach qw(YES NO UNDEF), "";
+}
+
 WriteConstants(
     PROXYSUBS => {autoload => 1},
     NAME => 'Socket',
index 17fda97..c6420e1 100644 (file)
@@ -1,8 +1,9 @@
 package Socket;
 
 use strict;
+{ use 5.006001; }
 
-our $VERSION = '1.97';
+our $VERSION = '1.98';
 
 =head1 NAME
 
index febe0b4..665553c 100644 (file)
@@ -71,29 +71,145 @@ NETINET_DEFINE_CONTEXT
 # define INADDR_LOOPBACK        0x7F000001
 #endif /* INADDR_LOOPBACK */
 
+#ifndef C_ARRAY_LENGTH
+#define C_ARRAY_LENGTH(arr) (sizeof(arr) / sizeof(*(arr)))
+#endif /* !C_ARRAY_LENGTH */
+
+#ifndef PERL_UNUSED_VAR
+# define PERL_UNUSED_VAR(x) ((void)x)
+#endif /* !PERL_UNUSED_VAR */
+
+#ifndef PERL_UNUSED_ARG
+# define PERL_UNUSED_ARG(x) PERL_UNUSED_VAR(x)
+#endif /* !PERL_UNUSED_ARG */
+
+#ifndef Newx
+# define Newx(v,n,t) New(0,v,n,t)
+#endif /* !Newx */
+
 #ifndef croak_sv
 # define croak_sv(sv)  croak(SvPV_nolen(sv))
 #endif
 
-/* perl < 5.8.9 or == 5.10.0 lacks newSVpvn_flags */
-#if PERL_VERSION < 8
-# define NEED_newSVpvn_flags
-#elif PERL_VERSION == 8 && PERL_SUBVERSION < 9
-# define NEED_newSVpvn_flags
-#elif PERL_VERSION == 10 && PERL_SUBVERSION == 0
-# define NEED_newSVpvn_flags
-#endif
+#ifndef hv_stores
+# define hv_stores(hv, keystr, val) \
+       hv_store(hv, ""keystr"", sizeof(keystr)-1, val, 0)
+#endif /* !hv_stores */
 
-#ifdef NEED_newSVpvn_flags
+#ifndef newSVpvn_flags
+# define newSVpvn_flags(s,len,flags) my_newSVpvn_flags(aTHX_ s,len,flags)
 static SV *my_newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags)
 {
   SV *sv = newSVpvn(s, len);
   SvFLAGS(sv) |= (flags & SVf_UTF8);
   return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
 }
+#endif /* !newSVpvn_flags */
 
-#define newSVpvn_flags(s,len,flags) my_newSVpvn_flags(aTHX_ s,len,flags)
-#endif
+#ifndef SvRV_set
+# define SvRV_set(sv, val) (SvRV(sv) = (val))
+#endif /* !SvRV_set */
+
+#ifndef SvPV_nomg
+# define SvPV_nomg SvPV
+#endif /* !SvPV_nomg */
+
+#ifndef HEK_FLAGS
+# define HEK_FLAGS(hek) 0
+# define HVhek_UTF8 1
+#endif /* !HEK_FLAGS */
+
+#ifndef hv_common
+/* These magic numbers are arbitrarily chosen (copied from perl core in fact)
+ * and only have to match between this definition and the code that uses them
+ */
+# define HV_FETCH_ISSTORE 0x04
+# define HV_FETCH_LVALUE  0x10
+# define hv_common(hv, keysv, key, klen, flags, act, val, hash) \
+       my_hv_common(aTHX_ hv, keysv, key, klen, flags, act, val, hash)
+static void *my_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
+       int flags, int act, SV *val, U32 hash)
+{
+       /*
+        * This only handles the usage actually made by the code
+        * generated by ExtUtils::Constant.  EU:C really ought to arrange
+        * portability of its generated code itself.
+        */
+       if (!keysv) {
+               keysv = sv_2mortal(newSVpvn(key, klen));
+               if (flags & HVhek_UTF8)
+                       SvUTF8_on(keysv);
+       }
+       if (act == HV_FETCH_LVALUE) {
+               return (void*)hv_fetch_ent(hv, keysv, 1, hash);
+       } else if (act == HV_FETCH_ISSTORE) {
+               return (void*)hv_store_ent(hv, keysv, val, hash);
+       } else {
+               croak("panic: my_hv_common: act=0x%x", act);
+       }
+}
+#endif /* !hv_common */
+
+#ifndef hv_common_key_len
+# define hv_common_key_len(hv, key, kl, act, val, hash) \
+       my_hv_common_key_len(aTHX_ hv, key, kl, act, val, hash)
+static void *my_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 kl,
+       int act, SV *val, U32 hash)
+{
+       STRLEN klen;
+       int flags;
+       if (kl < 0) {
+               klen = -kl;
+               flags = HVhek_UTF8;
+       } else {
+               klen = kl;
+               flags = 0;
+       }
+       return hv_common(hv, NULL, key, klen, flags, act, val, hash);
+}
+#endif /* !hv_common_key_len */
+
+#ifndef mPUSHi
+# define mPUSHi(i) sv_setiv_mg(PUSHs(sv_newmortal()), (IV)(i))
+#endif /* !mPUSHi */
+#ifndef mPUSHp
+# define mPUSHp(p,l) sv_setpvn_mg(PUSHs(sv_newmortal()), (p), (l))
+#endif /* !mPUSHp */
+
+#ifndef CvCONST_on
+# undef newCONSTSUB
+# define newCONSTSUB(stash, name, val) my_newCONSTSUB(aTHX_ stash, name, val)
+static CV *my_newCONSTSUB(pTHX_ HV *stash, char *name, SV *val)
+{
+       /*
+        * This has to satisfy code generated by ExtUtils::Constant.
+        * It depends on the 5.8+ layout of constant subs.  It has
+        * two calls to newCONSTSUB(): one for real constants, and one
+        * for undefined constants.  In the latter case, it turns the
+        * initially-generated constant subs into something else, and
+        * it needs the return value from newCONSTSUB() which Perl 5.6
+        * doesn't provide.
+        */
+       GV *gv;
+       CV *cv;
+       Perl_newCONSTSUB(aTHX_ stash, name, val);
+       ENTER;
+       SAVESPTR(PL_curstash);
+       PL_curstash = stash;
+       gv = gv_fetchpv(name, 0, SVt_PVCV);
+       cv = GvCV(gv);
+       LEAVE;
+       CvXSUBANY(cv).any_ptr = &PL_sv_undef;
+       return cv;
+}
+# define CvCONST_off(cv) my_CvCONST_off(aTHX_ cv)
+static void my_CvCONST_off(pTHX_ CV *cv)
+{
+       op_free(CvROOT(cv));
+       CvROOT(cv) = NULL;
+       CvSTART(cv) = NULL;
+}
+#endif /* !CvCONST_on */
 
 #ifndef HAS_INET_ATON
 
@@ -249,7 +365,7 @@ not_here(const char *s)
 static SV *err_to_SV(pTHX_ int err)
 {
        SV *ret = sv_newmortal();
-       SvUPGRADE(ret, SVt_PVNV);
+       (void) SvUPGRADE(ret, SVt_PVNV);
 
        if(err) {
                const char *error = gai_strerror(err);
@@ -281,6 +397,7 @@ static void xs_getaddrinfo(pTHX_ CV *cv)
        int err;
        int n_res;
 
+       PERL_UNUSED_ARG(cv);
        if(items > 3)
                croak("Usage: Socket::getaddrinfo(host, service, hints)");
 
@@ -386,6 +503,7 @@ static void xs_getnameinfo(pTHX_ CV *cv)
 
        int want_host, want_serv;
 
+       PERL_UNUSED_ARG(cv);
        if(items < 1 || items > 3)
                croak("Usage: Socket::getnameinfo(addr, flags=0, xflags=0)");
 
@@ -490,8 +608,8 @@ inet_ntoa(ip_address_sv)
                    (ip_address[2] & 0xFF) <<  8 |
                    (ip_address[3] & 0xFF);
        else
-               croak("Bad arg length for %s, length is %d, should be %d",
-                     "Socket::inet_ntoa", addrlen, sizeof(addr));
+               croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
+                     "Socket::inet_ntoa", (UV)addrlen, (UV)sizeof(addr));
        /* We could use inet_ntoa() but that is broken
         * in HP-UX + GCC + 64bitint (returns "0.0.0.0"),
         * so let's use this sprintf() workaround everywhere.
@@ -511,9 +629,9 @@ sockaddr_family(sockaddr)
        char *sockaddr_pv = SvPVbyte(sockaddr, sockaddr_len);
        CODE:
        if (sockaddr_len < offsetof(struct sockaddr, sa_data))
-               croak("Bad arg length for %s, length is %d, should be at least %d",
-                     "Socket::sockaddr_family", sockaddr_len,
-                     offsetof(struct sockaddr, sa_data));
+               croak("Bad arg length for %s, length is %"UVuf", should be at least %"UVuf,
+                     "Socket::sockaddr_family", (UV)sockaddr_len,
+                     (UV)offsetof(struct sockaddr, sa_data));
        ST(0) = sv_2mortal(newSViv(((struct sockaddr*)sockaddr_pv)->sa_family));
 
 void
@@ -593,8 +711,8 @@ unpack_sockaddr_un(sun_sv)
        /* On Linux sockaddrlen on sockets returned by accept, recvfrom,
           getpeername and getsockname is not equal to sizeof(addr). */
        if (sockaddrlen != sizeof(addr))
-               croak("Bad arg length for %s, length is %d, should be %d",
-                     "Socket::unpack_sockaddr_un", sockaddrlen, sizeof(addr));
+               croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
+                     "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)sizeof(addr));
 #   endif
 
        Copy(sun_ad, &addr, sizeof(addr), char);
@@ -638,9 +756,9 @@ pack_sockaddr_in(port, ip_address_sv)
                    (ip_address[2] & 0xFF) <<  8 |
                    (ip_address[3] & 0xFF);
        else
-               croak("Bad arg length for %s, length is %d, should be %d",
+               croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
                      "Socket::pack_sockaddr_in",
-                     addrlen, sizeof(addr));
+                     (UV)addrlen, (UV)sizeof(addr));
        Zero(&sin, sizeof(sin), char);
        sin.sin_family = AF_INET;
        sin.sin_port = htons(port);
@@ -662,7 +780,7 @@ unpack_sockaddr_in(sin_sv)
        struct in_addr  ip_address;
        char *  sin = SvPVbyte(sin_sv,sockaddrlen);
        if (sockaddrlen != sizeof(addr)) {
-           croak("Bad arg length for %s, length is %d, should be %d",
+           croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
                  "Socket::unpack_sockaddr_in", sockaddrlen, sizeof(addr));
        }
        Copy(sin, &addr, sizeof(addr), char);
@@ -686,7 +804,7 @@ pack_sockaddr_in6(port, sin6_addr, scope_id=0, flowinfo=0)
        unsigned long   flowinfo
        CODE:
        {
-#ifdef AF_INET6
+#ifdef HAS_SOCKADDR_IN6
        struct sockaddr_in6 sin6;
        char * addrbytes;
        STRLEN addrlen;
@@ -694,8 +812,8 @@ pack_sockaddr_in6(port, sin6_addr, scope_id=0, flowinfo=0)
                croak("Wide character in %s", "Socket::pack_sockaddr_in6");
        addrbytes = SvPVbyte(sin6_addr, addrlen);
        if (addrlen != sizeof(sin6.sin6_addr))
-               croak("Bad arg length %s, length is %d, should be %d",
-                     "Socket::pack_sockaddr_in6", addrlen, sizeof(sin6.sin6_addr));
+               croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
+                     "Socket::pack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6.sin6_addr));
        Zero(&sin6, sizeof(sin6), char);
        sin6.sin6_family = AF_INET6;
        sin6.sin6_port = htons(port);
@@ -722,13 +840,13 @@ unpack_sockaddr_in6(sin6_sv)
        SV *    sin6_sv
        PPCODE:
        {
-#ifdef AF_INET6
+#ifdef HAS_SOCKADDR_IN6
        STRLEN addrlen;
        struct sockaddr_in6 sin6;
        char * addrbytes = SvPVbyte(sin6_sv, addrlen);
        if (addrlen != sizeof(sin6))
-               croak("Bad arg length for %s, length is %d, should be %d",
-                     "Socket::unpack_sockaddr_in6", addrlen, sizeof(sin6));
+               croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
+                     "Socket::unpack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6));
        Copy(addrbytes, &sin6, sizeof(sin6), char);
        if (sin6.sin6_family != AF_INET6)
                croak("Bad address family for %s, got %d, should be %d",
@@ -829,7 +947,7 @@ pack_ipv6_mreq(addr, interface)
        unsigned int    interface
        CODE:
        {
-#ifdef AF_INET6
+#ifdef HAS_IPV6_MREQ
        struct ipv6_mreq mreq;
        char * addrbytes;
        STRLEN addrlen;
@@ -837,8 +955,8 @@ pack_ipv6_mreq(addr, interface)
                croak("Wide character in %s", "Socket::pack_ipv6_mreq");
        addrbytes = SvPVbyte(addr, addrlen);
        if (addrlen != sizeof(mreq.ipv6mr_multiaddr))
-               croak("Bad arg length %s, length is %d, should be %d",
-                     "Socket::pack_ipv6_mreq", addrlen, sizeof(mreq.ipv6mr_multiaddr));
+               croak("Bad arg length %s, length is %"UVuf", should be %"UVuf,
+                     "Socket::pack_ipv6_mreq", (UV)addrlen, (UV)sizeof(mreq.ipv6mr_multiaddr));
        Zero(&mreq, sizeof(mreq), char);
        Copy(addrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char);
        mreq.ipv6mr_interface = interface;
@@ -853,13 +971,13 @@ unpack_ipv6_mreq(mreq_sv)
        SV * mreq_sv
        PPCODE:
        {
-#ifdef AF_INET6
+#ifdef HAS_IPV6_MREQ
        struct ipv6_mreq mreq;
        STRLEN mreqlen;
        char * mreqbytes = SvPVbyte(mreq_sv, mreqlen);
        if (mreqlen != sizeof(mreq))
-               croak("Bad arg length for %s, length is %d, should be %d",
-                     "Socket::unpack_ipv6_mreq", mreqlen, sizeof(mreq));
+               croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
+                     "Socket::unpack_ipv6_mreq", (UV)mreqlen, (UV)sizeof(mreq));
        Copy(mreqbytes, &mreq, sizeof(mreq), char);
        EXTEND(SP, 2);
        mPUSHp((char *)&mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr));
index 8450324..b1c6748 100644 (file)
@@ -172,8 +172,7 @@ SKIP: {
 
 SKIP: {
     skip "No AF_INET6", 5 unless defined eval { AF_INET6() };
-
-    my $sin6 = pack_sockaddr_in6(0x1234, "0123456789abcdef", 0, 89);
+    skip "Cannot pack_sockaddr_in6()", 5 unless my $sin6 = eval { pack_sockaddr_in6(0x1234, "0123456789abcdef", 0, 89) };
 
     is(sockaddr_family($sin6), AF_INET6, 'sockaddr_family of pack_sockaddr_in6');
 
index 857b43c..817707a 100644 (file)
@@ -38,7 +38,7 @@ BEGIN {
            exit 1;
        }
     }
-    unless ($has_perlio = find PerlIO::Layer 'perlio') {
+    unless ($has_perlio = PerlIO::Layer->can("find") && PerlIO::Layer->find('perlio')) {
        print <<EOF;
 # Since you don't have perlio you might get failures with UTF-8 locales.
 EOF
@@ -168,6 +168,7 @@ ok (close RIGHT, "close right");
 
 SKIP: {
     skip "No usable SOCK_DGRAM for socketpair", 24 if ($^O =~ /^(MSWin32|os2)\z/);
+    skip "alarm doesn't interrupt I/O on this Perl", 24 if "$]" < 5.008;
     local $TODO = "socketpair not supported on $^O" if $^O eq 'nto';
 
     ok (socketpair (LEFT, RIGHT, AF_UNIX, SOCK_DGRAM, PF_UNSPEC),
diff --git a/cpan/Socket/typemap b/cpan/Socket/typemap
new file mode 100644 (file)
index 0000000..e884838
--- /dev/null
@@ -0,0 +1,2 @@
+TYPEMAP
+const char *   T_PV
index e42bf90..6423d09 100644 (file)
@@ -401,6 +401,10 @@ before Perl 5.16 [perl #108470].
 
 =item *
 
+L<Socket> has been upgraded from version 1.97 to version 1.98.
+
+=item *
+
 L<Time::HiRes>  has been upgraded from version 1.9724 to version 1.9725.
 
 C<Time::HiRes::stat()> no longer corrupts the Perl stack.