Update Socket to CPAN version 1.98

  [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

9 files changed, 190 insertions, 40 deletions

diff --git a/MANIFEST b/MANIFEST
index 903cda907b..0b0e226854 100644
--- 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
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index b11bd0966a..eeda6295c0 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -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',
     },
diff --git a/cpan/Socket/Makefile.PL b/cpan/Socket/Makefile.PL
index 43cc833014..ed6c210cb9 100644
--- a/cpan/Socket/Makefile.PL
+++ b/cpan/Socket/Makefile.PL
@@ -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',
diff --git a/cpan/Socket/Socket.pm b/cpan/Socket/Socket.pm
index 17fda97cfe..c6420e1904 100644
--- a/cpan/Socket/Socket.pm
+++ b/cpan/Socket/Socket.pm
@@ -1,8 +1,9 @@
 package Socket;
 
 use strict;
+{ use 5.006001; }
 
-our $VERSION = '1.97';
+our $VERSION = '1.98';
 
 =head1 NAME
 
diff --git a/cpan/Socket/Socket.xs b/cpan/Socket/Socket.xs
index febe0b473f..665553c94e 100644
--- a/cpan/Socket/Socket.xs
+++ b/cpan/Socket/Socket.xs
@@ -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));
diff --git a/cpan/Socket/t/Socket.t b/cpan/Socket/t/Socket.t
index 8450324316..b1c6748009 100644
--- a/cpan/Socket/t/Socket.t
+++ b/cpan/Socket/t/Socket.t
@@ -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');
 
diff --git a/cpan/Socket/t/socketpair.t b/cpan/Socket/t/socketpair.t
index 857b43cfdf..817707a6df 100644
--- a/cpan/Socket/t/socketpair.t
+++ b/cpan/Socket/t/socketpair.t
@@ -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
index 0000000000..e884838f20
--- /dev/null
+++ b/cpan/Socket/typemap
@@ -0,0 +1,2 @@
+TYPEMAP
+const char *	T_PV
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index e42bf90b8d..6423d09b03 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -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.