diff options
author | Piotr Trojanek <trojanek@adacore.com> | 2021-11-25 13:02:00 +0100 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2021-12-02 16:26:28 +0000 |
commit | 167be0845e555cf98a59d768002c7f48bf85fe11 (patch) | |
tree | 440180b8a16196dca70b334f46a7578cd170f686 /gcc | |
parent | e4b5ab01946554dabfc68090ae114182c96caf13 (diff) | |
download | gcc-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.ads | 2 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 24 | ||||
-rw-r--r-- | gcc/ada/sem_util.ads | 4 | ||||
-rw-r--r-- | gcc/ada/snames.ads-tmpl | 1 |
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 |