ada: Fix inconsistencies in conversion functions from Duration

The 3 units Ada.Calendar, GNAT.Calendar and GNAT.Sockets contain conversion
functions from the Duration fixed-point type that implement the same idiom
but with some inconsistencies:

  * GNAT.Sockets only handles Timeval_Duration, i.e. positive Duration, and
    is satisfactory, although a simpler implementation can be written,

  * GNAT.Calendar mishandles negative Duration values, as well as integral
    Duration values,

  * Ada.Calendar mishandles negative Duration values, and rounds nanoseconds
    instead of truncating them.

gcc/ada/ChangeLog:

	* libgnat/a-calend.adb (To_Struct_Timespec_64): Deal with negative
	Duration values and truncate the nanoseconds too.
	* libgnat/g-calend.adb (timeval_to_duration): Unsuppress overflow
	checks.
	(duration_to_timeval): Likewise.  Deal with negative Duration values
	as well as integral Duration values.
	* libgnat/g-socket.adb (To_Timeval): Simplify the implementation.

diff --git a/gcc/ada/libgnat/a-calend.adb b/gcc/ada/libgnat/a-calend.adb
index 4f89a401a9c97e5b0e69f73c95a373ff5511788e..0be56734ab2ad029083c7f5e60097ff006102834 100644 (file)
--- a/gcc/ada/libgnat/a-calend.adb
+++ b/gcc/ada/libgnat/a-calend.adb
@@ -1068,19 +1068,28 @@ is
          tv_nsec : out Long_Integer)
       is
          pragma Unsuppress (Overflow_Check);
-         Secs      : Duration;
-         Nano_Secs : Duration;
 
       begin
-         --  Seconds extraction, avoid potential rounding errors
-
-         Secs   := D - 0.5;
-         tv_sec := Long_Long_Integer (Secs);
-
-         --  Nanoseconds extraction
+         if D = 0.0 then
+            tv_sec  := 0;
+            tv_nsec := 0;
+
+         elsif D < 0.0 then
+            tv_sec := Long_Long_Integer (D + 0.5);
+            if D = Duration (tv_sec) then
+               tv_nsec := 0;
+            else
+               tv_nsec := Long_Integer ((D - Duration (tv_sec)) * Nano + 0.5);
+            end if;
 
-         Nano_Secs := D - Duration (tv_sec);
-         tv_nsec := Long_Integer (Nano_Secs * Nano);
+         else
+            tv_sec := Long_Long_Integer (D - 0.5);
+            if D = Duration (tv_sec) then
+               tv_nsec := 0;
+            else
+               tv_nsec := Long_Integer ((D - Duration (tv_sec)) * Nano - 0.5);
+            end if;
+         end if;
       end To_Struct_Timespec_64;
 
       ------------------

diff --git a/gcc/ada/libgnat/g-calend.adb b/gcc/ada/libgnat/g-calend.adb
index e410c3e9408fd25f0d3e18c2b123ece402d3f84d..a2bc77c1cc7b0d6a3ef2aa4f2b3b96d34e4a3535 100644 (file)
--- a/gcc/ada/libgnat/g-calend.adb
+++ b/gcc/ada/libgnat/g-calend.adb
@@ -344,6 +344,8 @@ package body GNAT.Calendar is
       sec   : aliased C.Extensions.long_long;
       usec  : aliased C.long;
 
+      pragma Unsuppress (Overflow_Check);
+
    begin
       timeval_to_duration (T, sec'Access, usec'Access);
       pragma Annotate (CodePeer, Modified, sec);
@@ -369,13 +371,28 @@ package body GNAT.Calendar is
       sec    : C.Extensions.long_long;
       usec   : C.long;
 
+      pragma Unsuppress (Overflow_Check);
+
    begin
       if D = 0.0 then
          sec  := 0;
          usec := 0;
+
+      elsif D < 0.0 then
+         sec := C.Extensions.long_long (D + 0.5);
+         if D = Duration (sec) then
+            usec := 0;
+         else
+            usec := C.long ((D - Duration (sec)) * Micro + 0.5);
+         end if;
+
       else
-         sec  := C.Extensions.long_long (D - 0.5);
-         usec := C.long ((D - Duration (sec)) * Micro - 0.5);
+         sec := C.Extensions.long_long (D - 0.5);
+         if D = Duration (sec) then
+            usec := 0;
+         else
+            usec := C.long ((D - Duration (sec)) * Micro - 0.5);
+         end if;
       end if;
 
       duration_to_timeval (sec, usec, Result'Access);

diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb
index 5042dacc166ff5fd9799f9e79fa09f687c5e1f1e..0fed79177544d69c7dd9ed5f94445fa54c92f5af 100644 (file)
--- a/gcc/ada/libgnat/g-socket.adb
+++ b/gcc/ada/libgnat/g-socket.adb
@@ -3059,12 +3059,11 @@ package body GNAT.Sockets is
       --  Normal case where we do round down
 
       else
-         S  := time_t (Val - 0.5);
-         uS := suseconds_t (1_000_000 * (Val - Selector_Duration (S)) - 0.5);
-
-         if uS = -1 then
-            --  It happen on integer duration
+         S := time_t (Val - 0.5);
+         if Val = Timeval_Duration (S) then
             uS := 0;
+         else
+            uS := suseconds_t ((Val - Timeval_Duration (S)) * 1_000_000 - 0.5);
          end if;
       end if;