[Ada] fix handling of delay until under windows

[Ada] fix handling of delay until under windows

[Arnaud Charlet]

[-- Attachment #1: Type: text/plain, Size: 1245 bytes --]

Manually tested on Windows
Tested on i686-linux, committed on trunk

This routine is used by the delay and delay until statements. The previous
implementation was using the monotonic clock (the clock used by Ada.Real_Time)
to compute the duration. This was not correct for the delay until statement
when the delay_expression is an Ada.Calendar.Time. Indeed this time could have
been adjusted by a DST, a user or by the GNAT runtime to resync the performance
counter and the current time.
This new implementation properly use the clock or monotonic clock depending
on the time (Calendar.Time or Real_Time.Time) used for delay_expression.
--
The following program must keep a delay until close to 10 seconds even after
a long run (more than 10 hours).
--
with Ada.Calendar;
with Ada.Text_IO;
procedure Test_Delay_Until is
   use Ada.Calendar;
   use Ada.Text_IO;
   Stamp : Ada.Calendar.Time;
begin
   loop
      Stamp := Clock;
      delay until Stamp + 10.0;
      Put_Line (Duration'Image (Clock - Stamp));
   end loop;
end Test_Delay_Until;

2007-04-06  Pascal Obry  <obry@adacore.com>

	* s-osprim-mingw.adb (Timed_Delay): Use the right clock (standard one
	or the monotonic used by Ada.Real_Time) to compute the sleep duration
	on Windows.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 3156 bytes --]

Index: s-osprim-mingw.adb
===================================================================
--- s-osprim-mingw.adb	(revision 123291)
+++ s-osprim-mingw.adb	(working copy)
@@ -4,9 +4,9 @@
 --                                                                          --
 --                  S Y S T E M . O S _ P R I M I T I V E S                 --
 --                                                                          --
---                                  B o d y                                 --
+--                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1998-2006, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -51,16 +51,17 @@ package body System.OS_Primitives is
    type BOOL is new Boolean;
    for BOOL'Size use Interfaces.C.unsigned_long'Size;
 
-   procedure GetSystemTimeAsFileTime (lpFileTime : access Long_Long_Integer);
+   procedure GetSystemTimeAsFileTime
+     (lpFileTime : not null access Long_Long_Integer);
    pragma Import (Stdcall, GetSystemTimeAsFileTime, "GetSystemTimeAsFileTime");
 
    function QueryPerformanceCounter
-     (lpPerformanceCount : access LARGE_INTEGER) return BOOL;
+     (lpPerformanceCount : not null access LARGE_INTEGER) return BOOL;
    pragma Import
      (Stdcall, QueryPerformanceCounter, "QueryPerformanceCounter");
 
    function QueryPerformanceFrequency
-     (lpFrequency : access LARGE_INTEGER) return BOOL;
+     (lpFrequency : not null access LARGE_INTEGER) return BOOL;
    pragma Import
      (Stdcall, QueryPerformanceFrequency, "QueryPerformanceFrequency");
 
@@ -241,9 +242,29 @@ package body System.OS_Primitives is
    -----------------
 
    procedure Timed_Delay (Time : Duration; Mode : Integer) is
+
+      function Mode_Clock return Duration;
+      pragma Inline (Mode_Clock);
+      --  Return the current clock value using either the monotonic clock or
+      --  standard clock depending on the Mode value.
+
+      ----------------
+      -- Mode_Clock --
+      ----------------
+
+      function Mode_Clock return Duration is
+      begin
+         case Mode is
+            when Absolute_RT =>
+               return Monotonic_Clock;
+            when others =>
+               return Clock;
+         end case;
+      end Mode_Clock;
+
       Rel_Time   : Duration;
       Abs_Time   : Duration;
-      Check_Time : Duration := Monotonic_Clock;
+      Check_Time : Duration := Mode_Clock;
 
    begin
       if Mode = Relative then
@@ -257,7 +278,7 @@ package body System.OS_Primitives is
       if Rel_Time > 0.0 then
          loop
             Sleep (DWORD (Rel_Time * 1000.0));
-            Check_Time := Monotonic_Clock;
+            Check_Time := Mode_Clock;
 
             exit when Abs_Time <= Check_Time;