diff mbox series

[Ada] Cleanup detection of suspension objects

Message ID 20211202162901.GA2159643@adacore.com
State New
Headers show
Series [Ada] Cleanup detection of suspension objects | expand

Commit Message

Pierre-Marie de Rodat Dec. 2, 2021, 4:29 p.m. UTC 
Current implementation of Is_Suspension_Object is a leftover from an old
code of Is_Descendant_Of_Suspension_Object, which used RTE_Available and
indeed couldn't be called from GNATprove.

Now Is_Descendant_Of_Suspension_Object can work with Is_RTE, which can
be safely called from GNATprove.

Cleanup only; behaviour of GNAT and GNATprove is not affected.

Tested on x86_64-pc-linux-gnu, committed on trunk

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 mbox series

Patch

diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
--- 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
--- 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
--- 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
--- 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