From 6b6a0f02ab7012daebd62726066b827fbdfa62f9 Mon Sep 17 00:00:00 2001 From: Dmitriy Anisimkov Date: Tue, 11 Dec 2018 11:10:53 +0000 Subject: [PATCH] [Ada] GNAT.Sockets: fix timeout computations for sockets 2018-12-11 Dmitriy Anisimkov gcc/ada/ * libgnat/g-socket.ads, libgnat/g-socket.adb: Fix duration computations to be compatible with the type for socket timeouts on Windows. From-SVN: r266998 --- gcc/ada/ChangeLog | 6 ++++ gcc/ada/libgnat/g-socket.adb | 53 ++++++++++++++++++++++++++---------- gcc/ada/libgnat/g-socket.ads | 9 ++++-- 3 files changed, 52 insertions(+), 16 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c16a043029a..34c3a2fad4a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2018-12-11 Dmitriy Anisimkov + + * libgnat/g-socket.ads, libgnat/g-socket.adb: Fix duration + computations to be compatible with the type for socket timeouts + on Windows. + 2018-12-11 Gary Dismukes * exp_util.ads: Use preferred U.S. spelling of "honored". diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb index 721571fb8b9..2a5047d399c 100644 --- a/gcc/ada/libgnat/g-socket.adb +++ b/gcc/ada/libgnat/g-socket.adb @@ -1154,10 +1154,12 @@ package body GNAT.Sockets is Optname : Interfaces.C.int := -1) return Option_Type is use SOSC; + use type C.unsigned; use type C.unsigned_char; V8 : aliased Two_Ints; V4 : aliased C.int; + U4 : aliased C.unsigned; V1 : aliased C.unsigned_char; VT : aliased Timeval; Len : aliased C.int; @@ -1207,8 +1209,8 @@ package body GNAT.Sockets is -- a DWORD. if Target_OS = Windows then - Len := V4'Size / 8; - Add := V4'Address; + Len := U4'Size / 8; + Add := U4'Address; else Len := VT'Size / 8; @@ -1286,10 +1288,10 @@ package body GNAT.Sockets is -- Timeout is in milliseconds, actual value is 500 ms + -- returned value (unless it is 0). - if V4 = 0 then + if U4 = 0 then Opt.Timeout := 0.0; else - Opt.Timeout := Natural (V4) * 0.001 + 0.500; + Opt.Timeout := Duration (U4) / 1000 + 0.500; end if; else @@ -2293,9 +2295,11 @@ package body GNAT.Sockets is Option : Option_Type) is use SOSC; + use type C.unsigned; V8 : aliased Two_Ints; V4 : aliased C.int; + U4 : aliased C.unsigned; V1 : aliased C.unsigned_char; VT : aliased Timeval; Len : C.int; @@ -2376,17 +2380,17 @@ package body GNAT.Sockets is -- the actual timeout is 500 ms + the given value (unless it -- is 0). - V4 := C.int (Option.Timeout / 0.001); + U4 := C.unsigned (Option.Timeout / 0.001); - if V4 > 500 then - V4 := V4 - 500; + if U4 > 500 then + U4 := U4 - 500; - elsif V4 > 0 then - V4 := 1; + elsif U4 > 0 then + U4 := 1; end if; - Len := V4'Size / 8; - Add := V4'Address; + Len := U4'Size / 8; + Add := U4'Address; else VT := To_Timeval (Option.Timeout); @@ -2509,8 +2513,24 @@ package body GNAT.Sockets is ----------------- function To_Duration (Val : Timeval) return Timeval_Duration is - begin - return Natural (Val.Tv_Sec) * 1.0 + Natural (Val.Tv_Usec) * 1.0E-6; + Max_D : constant Long_Long_Integer := Long_Long_Integer (Forever - 0.5); + Tv_sec_64 : constant Boolean := SOSC.SIZEOF_tv_sec = 8; + -- Need to separate this condition into the constant declaration to + -- avoid GNAT warning about "always true" or "always false". + begin + if Tv_sec_64 then + -- Check for possible Duration overflow when Tv_Sec field is 64 bit + -- integer. + + if Val.Tv_Sec > time_t (Max_D) or else + (Val.Tv_Sec = time_t (Max_D) and then + Val.Tv_Usec > suseconds_t ((Forever - Duration (Max_D)) * 1E6)) + then + return Forever; + end if; + end if; + + return Duration (Val.Tv_Sec) + Duration (Val.Tv_Usec) * 1.0E-6; end To_Duration; ------------------- @@ -2701,7 +2721,12 @@ package body GNAT.Sockets is else S := time_t (Val - 0.5); - uS := suseconds_t (1_000_000 * (Val - Selector_Duration (S))); + uS := suseconds_t (1_000_000 * (Val - Selector_Duration (S)) - 0.5); + + if uS = -1 then + -- It happen on integer duration + uS := 0; + end if; end if; return (S, uS); diff --git a/gcc/ada/libgnat/g-socket.ads b/gcc/ada/libgnat/g-socket.ads index 03b3f9548cf..964a180d981 100644 --- a/gcc/ada/libgnat/g-socket.ads +++ b/gcc/ada/libgnat/g-socket.ads @@ -433,8 +433,13 @@ package GNAT.Sockets is Immediate : constant Duration := 0.0; Forever : constant Duration := - Duration'Min (Duration'Last, 1.0 * SOSC.MAX_tv_sec); - -- Largest possible Duration that is also a valid value for struct timeval + Duration'Min + (Duration'Last, + (if SOSC."=" (SOSC.Target_OS, SOSC.Windows) + then Duration (2 ** 32 / 1000) + else 1.0 * SOSC.MAX_tv_sec)); + -- Largest possible Duration that is also a valid value for the OS type + -- used for socket timeout. subtype Timeval_Duration is Duration range Immediate .. Forever; -- 2.30.2