From: Eric Botcazou <ebotcazou@adacore.com>
Date: Fri, 27 Sep 2024 07:36:17 +0000 (+0200)
Subject: ada: Fix ATC with timed delay from Ada.Real_Time
X-Git-Tag: basepoints/gcc-16~4908
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=8af9169fcf792531ca7bbaac80d15123c7970f06;p=thirdparty%2Fgcc.git

ada: Fix ATC with timed delay from Ada.Real_Time

An Asynchronous Transfer of Control blocks with a timed delay that is
computed by means of the Ada.Real_Time unit (instead of the default
Ada.Calendar unit) because of a missing abort deferral in the unit.

gcc/ada/ChangeLog:

	PR ada/43485
	* libgnarl/a-retide.adb: Add with clause for System.Soft_Links.
	(Delay_Until): Defer and undefer abort around the call to the
	Timed_Delay routine of System.Task_Primitives.Operations.
---

diff --git a/gcc/ada/libgnarl/a-retide.adb b/gcc/ada/libgnarl/a-retide.adb
index 80e3d31ed17d..d7cac0f2124f 100644
--- a/gcc/ada/libgnarl/a-retide.adb
+++ b/gcc/ada/libgnarl/a-retide.adb
@@ -31,11 +31,13 @@
 
 with Ada.Exceptions;
 
+with System.Soft_Links;
 with System.Tasking;
 with System.Task_Primitives.Operations;
 
 package body Ada.Real_Time.Delays is
 
+   package SSL  renames System.Soft_Links;
    package STPO renames System.Task_Primitives.Operations;
 
    ----------------
@@ -62,7 +64,9 @@ package body Ada.Real_Time.Delays is
          Ada.Exceptions.Raise_Exception
            (Program_Error'Identity, "potentially blocking operation");
       else
+         SSL.Abort_Defer.all;
          STPO.Timed_Delay (Self_Id, To_Duration (T), Absolute_RT);
+         SSL.Abort_Undefer.all;
       end if;
    end Delay_Until;