This change adds a special case to Get_Socket_Option and Set_Socket_Option
to account for a deviation of Windows' behaviour with respect to the
standard sockets API: on that target, SO_RCVTIMEO and SO_SNDTIMEO expect
a DWORD containing a milliseconds count, not a struct timeval, and furthermore
if this milliseconds count is non-zero, then the actual timeout is 500 ms
greater.
No test (timing issue).
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-07-30 Thomas Quinot <qui...@adacore.com>
* g-socket.adb (Get_Socket_Option, Set_Socket_Option): On Windows, the
value is a milliseconds count in a DWORD, not a struct timeval.
Index: g-socket.adb
===================================================================
--- g-socket.adb (revision 189974)
+++ g-socket.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2011, AdaCore --
+-- Copyright (C) 2001-2012, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -1112,6 +1112,7 @@
Level : Level_Type := Socket_Level;
Name : Option_Name) return Option_Type
is
+ use SOSC;
use type C.unsigned_char;
V8 : aliased Two_Ints;
@@ -1144,9 +1145,23 @@
when Send_Timeout |
Receive_Timeout =>
- Len := VT'Size / 8;
- Add := VT'Address;
+ -- The standard argument for SO_RCVTIMEO and SO_SNDTIMEO is a
+ -- struct timeval, but on Windows it is a milliseconds count in
+ -- a DWORD.
+
+ pragma Warnings (Off);
+ if Target_OS = Windows then
+ pragma Warnings (On);
+
+ Len := V4'Size / 8;
+ Add := V4'Address;
+
+ else
+ Len := VT'Size / 8;
+ Add := VT'Address;
+ end if;
+
when Linger |
Add_Membership |
Drop_Membership =>
@@ -1201,7 +1216,23 @@
when Send_Timeout |
Receive_Timeout =>
- Opt.Timeout := To_Duration (VT);
+
+ pragma Warnings (Off);
+ if Target_OS = Windows then
+ pragma Warnings (On);
+
+ -- Timeout is in milliseconds, actual value is 500 ms +
+ -- returned value (unless it is 0).
+
+ if V4 = 0 then
+ Opt.Timeout := 0.0;
+ else
+ Opt.Timeout := Natural (V4) * 0.001 + 0.500;
+ end if;
+
+ else
+ Opt.Timeout := To_Duration (VT);
+ end if;
end case;
return Opt;
@@ -2176,6 +2207,8 @@
Level : Level_Type := Socket_Level;
Option : Option_Type)
is
+ use SOSC;
+
V8 : aliased Two_Ints;
V4 : aliased C.int;
V1 : aliased C.unsigned_char;
@@ -2236,10 +2269,33 @@
when Send_Timeout |
Receive_Timeout =>
- VT := To_Timeval (Option.Timeout);
- Len := VT'Size / 8;
- Add := VT'Address;
+ pragma Warnings (Off);
+ if Target_OS = Windows then
+ pragma Warnings (On);
+
+ -- On Windows, the timeout is a DWORD in milliseconds, and
+ -- the actual timeout is 500 ms + the given value (unless it
+ -- is 0).
+
+ V4 := C.int (Option.Timeout / 0.001);
+
+ if V4 > 500 then
+ V4 := V4 - 500;
+
+ elsif V4 > 0 then
+ V4 := 1;
+ end if;
+
+ Len := V4'Size / 8;
+ Add := V4'Address;
+
+ else
+ VT := To_Timeval (Option.Timeout);
+ Len := VT'Size / 8;
+ Add := VT'Address;
+ end if;
+
end case;
Res := C_Setsockopt
