aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorPiotr Trojanek <trojanek@adacore.com>2021-11-25 13:02:00 +0100
committerPierre-Marie de Rodat <derodat@adacore.com>2021-12-02 16:26:28 +0000
commit167be0845e555cf98a59d768002c7f48bf85fe11 (patch)
tree440180b8a16196dca70b334f46a7578cd170f686 /gcc
parente4b5ab01946554dabfc68090ae114182c96caf13 (diff)
downloadgcc-167be0845e555cf98a59d768002c7f48bf85fe11.zip
gcc-167be0845e555cf98a59d768002c7f48bf85fe11.tar.gz
gcc-167be0845e555cf98a59d768002c7f48bf85fe11.tar.bz2
[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.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/rtsfind.ads2
-rw-r--r--gcc/ada/sem_util.adb24
-rw-r--r--gcc/ada/sem_util.ads4
-rw-r--r--gcc/ada/snames.ads-tmpl1
4 files changed, 3 insertions, 28 deletions
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index bedea07..2802a64 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 c6e1830..882eb23 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 9ab2528..b2bd9d5 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 e1af28b..cf4327a 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