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