From: Eric Botcazou <ebotca...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/libgnat/a-calend.adb | 27 ++++++++++++++++++---------
gcc/ada/libgnat/g-calend.adb | 21 +++++++++++++++++++--
gcc/ada/libgnat/g-socket.adb | 9 ++++-----
3 files changed, 41 insertions(+), 16 deletions(-)
diff --git a/gcc/ada/libgnat/a-calend.adb b/gcc/ada/libgnat/a-calend.adb
index 4f89a401a9c..0be56734ab2 100644
--- 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
+ if D = 0.0 then
+ tv_sec := 0;
+ tv_nsec := 0;
- Secs := D - 0.5;
- tv_sec := Long_Long_Integer (Secs);
+ 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;
- -- Nanoseconds extraction
-
- 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 e410c3e9408..a2bc77c1cc7 100644
--- 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 5042dacc166..0fed7917754 100644
--- 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;
--
2.43.0
