[Ada] Don't correct socket timeout on Windows Server 2019

2020-06-12  Dmitriy Anisimkov  <anisimko@adacore.com>

gcc/ada/

	* socket.c (__gnat_minus_500ms): Use GetVersionEx to detect
	Windows Server version.
	* libgnat/g-sothco.ads (Minus_500ms_Windows_Timeout): Remade to
	Boolean constant.
	* libgnat/g-socket.adb (Set_Socket_Option): Use
	Minus_500ms_Windows_Timeout constant instead of function call.

diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb
index fd6a494..4c6566b 100644 (file)
--- a/gcc/ada/libgnat/g-socket.adb
+++ b/gcc/ada/libgnat/g-socket.adb
@@ -2722,7 +2722,7 @@ package body GNAT.Sockets is
                --  Old windows versions actual timeout is 500 ms + the given
                --  value (unless it is 0).
 
-               if Minus_500ms_Windows_Timeout /= 0 then
+               if Minus_500ms_Windows_Timeout then
                   if U4 > 500 then
                      U4 := U4 - 500;
 

diff --git a/gcc/ada/libgnat/g-sothco.ads b/gcc/ada/libgnat/g-sothco.ads
index e3ca003..cc7bccd 100644 (file)
--- a/gcc/ada/libgnat/g-sothco.ads
+++ b/gcc/ada/libgnat/g-sothco.ads
@@ -451,12 +451,19 @@ package GNAT.Sockets.Thin_Common is
    renames Short_To_Network;
    --  Symmetric operation
 
-   function Minus_500ms_Windows_Timeout return C.int;
+   Minus_500ms_Windows_Timeout : constant Boolean;
    --  Microsoft Windows desktop older then 8.0 and Microsoft Windows Server
    --  older than 2019 need timeout correction for 500 milliseconds. This
-   --  routine returns 1 for such versions.
+   --  constant is True for such versions.
 
 private
+
+   function Get_Minus_500ms_Timeout return C.int
+     with Import, Convention => C, External_Name => "__gnat_minus_500ms";
+
+   Minus_500ms_Windows_Timeout : constant Boolean :=
+                                   Get_Minus_500ms_Timeout /= 0;
+
    pragma Import (C, Get_Socket_From_Set, "__gnat_get_socket_from_set");
    pragma Import (C, Is_Socket_In_Set, "__gnat_is_socket_in_set");
    pragma Import (C, Last_Socket_In_Set, "__gnat_last_socket_in_set");
@@ -488,6 +495,4 @@ private
    pragma Import (C, Hostent_H_Length,   "__gnat_hostent_h_length");
    pragma Import (C, Hostent_H_Addr,     "__gnat_hostent_h_addr");
 
-   pragma Import (C, Minus_500ms_Windows_Timeout, "__gnat_minus_500ms");
-
 end GNAT.Sockets.Thin_Common;

diff --git a/gcc/ada/socket.c b/gcc/ada/socket.c
index 4e36790..dd73c6a 100644 (file)
--- a/gcc/ada/socket.c
+++ b/gcc/ada/socket.c
@@ -801,14 +801,26 @@ const char * __gnat_gai_strerror(int errcode) {
 
 int __gnat_minus_500ms() {
 #if defined (_WIN32)
-  // Windows 8.0 and newer do not need 500 millisecond socket timeout
-  // correction.
-  // We do not know the Windows server version without socket timeout
-  // correction for now. When we know, we can add the call for
-  // IsWindowsVersionOrGreater(10, 0, ????) into condition.
-  return !IsWindows8OrGreater() || IsWindowsServer();
+  // Windows Server 2019 and Windows 8.0 do not need 500 millisecond socket
+  // timeout correction.
+  if (IsWindowsServer()) {
+    OSVERSIONINFO osvi;
+    ZeroMemory(&osvi, sizeof(OSVERSIONINFO));
+    osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+    // Documentation proposes to use IsWindowsVersionOrGreater(10, 0, 17763)
+    // but it does not compare by the build number (last parameter). See
+    // regression test for RC03-012 in fixedbugs, there are some code to
+    // investigate Windows version API behavior.
+    GetVersionEx(&osvi);
+    return osvi.dwMajorVersion < 10
+        || osvi.dwMajorVersion == 10
+        && osvi.dwMinorVersion == 0
+        && osvi.dwBuildNumber < 17763;
+  } else {
+    return !IsWindows8OrGreater();
+  }
 #else
-   return 0;
+  return 0;
 #endif
 }