[perl.git] branch blead updated. v5.29.7-161-g2e51033c15

[Tony Cook]

In perl.git, the branch blead has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/2e51033c15c9a62065f9d7f20df90faa02d058fc?hp=737b460d4977201e63598daf5cc7d1c00b9fb809>

- Log -----------------------------------------------------------------
-----------------------------------------------------------------------

Summary of changes:
 t/io/socket.t    | 12 ++++++++++++
 win32/win32sck.c |  6 +++++-
 2 files changed, 17 insertions(+), 1 deletion(-)

diff --git a/t/io/socket.t b/t/io/socket.t
index be3abc0e1e..2dce1a7d08 100644
--- a/t/io/socket.t
+++ b/t/io/socket.t
@@ -44,6 +44,18 @@ my $fork = $Config{d_fork} || $Config{d_pseudofork};
     ok(close($sock), "close the socket");
 }
 
+SKIP:
+{
+    $udp
+        or skip "No udp", 1;
+    # [perl #133853] failed socket creation didn't set error
+    # for bad parameters on Win32
+    $! = 0;
+    socket(my $sock, PF_INET, SOCK_STREAM, $udp)
+        and skip "managed to make a UDP stream socket", 1;
+    ok(0+$!, "error set on failed socket()");
+}
+
 SKIP: {
     # test it all in TCP
     $local or skip("No localhost", 3);
diff --git a/win32/win32sck.c b/win32/win32sck.c
index d9d7f3692b..d285ece082 100644
--- a/win32/win32sck.c
+++ b/win32/win32sck.c
@@ -613,7 +613,7 @@ open_ifs_socket(int af, int type, int protocol)
     dTHX;
     char *s;
     unsigned long proto_buffers_len = 0;
-    int error_code;
+    int error_code, found = 0;
     SOCKET out = INVALID_SOCKET;
 
     if ((s = PerlEnv_getenv("PERL_ALLOW_NON_IFS_LSP")) && atoi(s))
@@ -645,11 +645,15 @@ open_ifs_socket(int af, int type, int protocol)
                 if ((proto_buffers[i].dwServiceFlags1 & XP1_IFS_HANDLES) == 0)
                     continue;
 
+                found = 1;
                 convert_proto_info_w2a(&(proto_buffers[i]), &proto_info);
 
                 out = WSASocket(af, type, protocol, &proto_info, 0, 0);
                 break;
             }
+
+            if (!found)
+                WSASetLastError(WSAEPROTONOSUPPORT);
         }
 
         Safefree(proto_buffers);

-- 
Perl5 Master Repository