From: Piotr Trojanek <trojanek@adacore.com>
Date: Thu, 25 Nov 2021 12:02:00 +0000 (+0100)
Subject: [Ada] Cleanup detection of suspension objects
X-Git-Tag: basepoints/gcc-13~2574
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=167be0845e555cf98a59d768002c7f48bf85fe11;p=thirdparty%2Fgcc.git

[Ada] Cleanup detection of suspension objects

gcc/ada/

	* rtsfind.ads (RE_Id, RE_Unit_Table): Add RE_Suspension_Object.
	* sem_util.adb (Is_Descendant_Of_Suspension_Object): Use Is_RTE.
	(Is_Suspension_Object): Remove body.
	* sem_util.ads (Is_Suspension_Object): Remove spec.
	* snames.ads-tmpl (Name_Suspension_Object): Remove, now
	unreferenced.
---

diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index bedea071c7fc..2802a649a628 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -626,6 +626,7 @@ package Rtsfind is
      RE_Wait_For_Release,                -- Ada.Synchronous_Barriers
 
      RE_Suspend_Until_True,              -- Ada.Synchronous_Task_Control
+     RE_Suspension_Object,               -- Ada.Synchronous_Task_Control
 
      RE_Access_Level,                    -- Ada.Tags
      RE_Alignment,                       -- Ada.Tags
@@ -2311,6 +2312,7 @@ package Rtsfind is
      RE_Wait_For_Release                 => Ada_Synchronous_Barriers,
 
      RE_Suspend_Until_True               => Ada_Synchronous_Task_Control,
+     RE_Suspension_Object                => Ada_Synchronous_Task_Control,
 
      RE_Access_Level                     => Ada_Tags,
      RE_Alignment                        => Ada_Tags,
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index c6e183037736..882eb23b4023 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -17236,7 +17236,7 @@ package body Sem_Util is
 
          --  The current type is a match
 
-         if Is_Suspension_Object (Cur_Typ) then
+         if Is_RTE (Cur_Typ, RE_Suspension_Object) then
             return True;
 
          --  Stop the traversal once the root of the derivation chain has been
@@ -21123,28 +21123,6 @@ package body Sem_Util is
       return True;
    end Is_Suitable_Primitive;
 
-   --------------------------
-   -- Is_Suspension_Object --
-   --------------------------
-
-   function Is_Suspension_Object (Id : Entity_Id) return Boolean is
-   begin
-      --  This approach does an exact name match rather than to rely on
-      --  RTSfind. Routine Is_Effectively_Volatile is used by clients of the
-      --  front end at point where all auxiliary tables are locked and any
-      --  modifications to them are treated as violations. Do not tamper with
-      --  the tables, instead examine the Chars fields of all the scopes of Id.
-
-      return
-        Chars (Id) = Name_Suspension_Object
-          and then Present (Scope (Id))
-          and then Chars (Scope (Id)) = Name_Synchronous_Task_Control
-          and then Present (Scope (Scope (Id)))
-          and then Chars (Scope (Scope (Id))) = Name_Ada
-          and then Present (Scope (Scope (Scope (Id))))
-          and then Scope (Scope (Scope (Id))) = Standard_Standard;
-   end Is_Suspension_Object;
-
    ----------------------------
    -- Is_Synchronized_Object --
    ----------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 9ab2528fd443..b2bd9d580a44 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2440,10 +2440,6 @@ package Sem_Util is
    --  Determine whether arbitrary subprogram Subp_Id may act as a primitive of
    --  an arbitrary tagged type.
 
-   function Is_Suspension_Object (Id : Entity_Id) return Boolean;
-   --  Determine whether arbitrary entity Id denotes Suspension_Object defined
-   --  in Ada.Synchronous_Task_Control.
-
    function Is_Synchronized_Object (Id : Entity_Id) return Boolean;
    --  Determine whether entity Id denotes an object and if it does, whether
    --  this object is synchronized as specified in SPARK RM 9.1. To qualify as
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index e1af28bf6774..cf4327a9d81d 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -1401,7 +1401,6 @@ package Snames is
    --  e.g. Name_UP_RESULT corresponds to the name "RESULT".
 
    Name_UP_RESULT                        : constant Name_Id := N + $;
-   Name_Suspension_Object                : constant Name_Id := N + $;
    Name_Synchronous_Task_Control         : constant Name_Id := N + $;
 
    --  Names used to implement iterators over predefined containers