diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 23 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 281 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 24 |
5 files changed, 216 insertions, 134 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a4ab24a..a3832b8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2019-12-16 Eric Botcazou <ebotcazou@adacore.com> + + * sem_ch8.adb (Analyze_Object_Renaming): Set Atomic, Independent + and Volatile_Full_Access aspects on the entity of the renaming + the same way as the Volatile aspect is set. + * sem_util.ads (Is_Atomic_Object_Entity): Move declaration to... + (Is_Independent_Object): New function. + (Is_Volatile_Full_Access_Object): Likewise. + * sem_util.adb (Is_Atomic_Object_Entity): ...here. + (Prefix_Has_Atomic_Components): Minor tweak. + (Is_Atomic_Object): Test Is_Atomic on the Etype uniformly. + (Is_Atomic_Or_VFA_Object): Call Is_Volatile_Full_Access_Object. + (Is_Independent_Object): New predicate. + (Is_Subcomponent_Of_Atomic_Object): Remove redundant test. + (Is_Volatile_Full_Access_Object): New predicate. + (Is_Volatile_Prefix): Rename into... + (Prefix_Has_Volatile_Components): ... and call + Is_Volatile_Object. + (Object_Has_Volatile_Components): Delete. + (Is_Volatile_Object): Simplify. + * gcc-interface/trans.c (node_is_volatile_full_access): Adjust + comment. + 2019-12-16 Bob Duff <duff@adacore.com> * par.adb: Add Scopes function to do range checking on the scope diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 762ca46..e6914cc 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -4835,8 +4835,8 @@ node_is_atomic (Node_Id gnat_node) } /* Return true if GNAT_NODE references a Volatile_Full_Access entity. This is - modeled on the Is_VFA_Object predicate of the front-end, but additionally - handles explicit dereferences. */ + modeled on the Is_Volatile_Full_Access_Object predicate of the front-end, + but additionally handles explicit dereferences. */ static bool node_is_volatile_full_access (Node_Id gnat_node) diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 8897b25..a1a5274 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -1358,19 +1358,13 @@ package body Sem_Ch8 is end if; -- The entity of the renaming declaration needs to reflect whether the - -- renamed object is volatile. Is_Volatile is set if the renamed object - -- is volatile in the RM legality sense. + -- renamed object is atomic, independent, volatile or VFA. These flags + -- are set on the renamed object in the RM legality sense. - Set_Is_Volatile (Id, Is_Volatile_Object (Nam)); - - -- Also copy settings of Atomic/Independent/Volatile_Full_Access - - if Is_Entity_Name (Nam) then - Set_Is_Atomic (Id, Is_Atomic (Entity (Nam))); - Set_Is_Independent (Id, Is_Independent (Entity (Nam))); - Set_Is_Volatile_Full_Access (Id, - Is_Volatile_Full_Access (Entity (Nam))); - end if; + Set_Is_Atomic (Id, Is_Atomic_Object (Nam)); + Set_Is_Independent (Id, Is_Independent_Object (Nam)); + Set_Is_Volatile (Id, Is_Volatile_Object (Nam)); + Set_Is_Volatile_Full_Access (Id, Is_Volatile_Full_Access_Object (Nam)); -- Treat as volatile if we just set the Volatile flag diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 7212637..e1703e9 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -122,6 +122,10 @@ package body Sem_Util is -- T is a derived tagged type. Check whether the type extension is null. -- If the parent type is fully initialized, T can be treated as such. + function Is_Atomic_Object_Entity (Id : Entity_Id) return Boolean; + -- Determine whether arbitrary entity Id denotes an atomic object as per + -- RM C.6(7). + function Is_Fully_Initialized_Variant (Typ : Entity_Id) return Boolean; -- Subsidiary to Is_Fully_Initialized_Type. For an unconstrained type -- with discriminants whose default values are static, examine only the @@ -13724,16 +13728,16 @@ package body Sem_Util is ---------------------- function Is_Atomic_Object (N : Node_Id) return Boolean is - function Prefix_Has_Atomic_Components (Pref : Node_Id) return Boolean; - -- Determine whether prefix Pref of an indexed component has atomic - -- components. + function Prefix_Has_Atomic_Components (P : Node_Id) return Boolean; + -- Determine whether prefix P has atomic components. This requires the + -- presence of an Atomic_Components aspect/pragma. --------------------------------- -- Prefix_Has_Atomic_Components -- --------------------------------- - function Prefix_Has_Atomic_Components (Pref : Node_Id) return Boolean is - Typ : constant Entity_Id := Etype (Pref); + function Prefix_Has_Atomic_Components (P : Node_Id) return Boolean is + Typ : constant Entity_Id := Etype (P); begin if Is_Access_Type (Typ) then @@ -13742,8 +13746,8 @@ package body Sem_Util is elsif Has_Atomic_Components (Typ) then return True; - elsif Is_Entity_Name (Pref) - and then Has_Atomic_Components (Entity (Pref)) + elsif Is_Entity_Name (P) + and then Has_Atomic_Components (Entity (P)) then return True; @@ -13758,18 +13762,18 @@ package body Sem_Util is if Is_Entity_Name (N) then return Is_Atomic_Object_Entity (Entity (N)); + elsif Is_Atomic (Etype (N)) then + return True; + elsif Nkind (N) = N_Indexed_Component then - return - Is_Atomic (Etype (N)) - or else Prefix_Has_Atomic_Components (Prefix (N)); + return Prefix_Has_Atomic_Components (Prefix (N)); elsif Nkind (N) = N_Selected_Component then - return - Is_Atomic (Etype (N)) - or else Is_Atomic (Entity (Selector_Name (N))); - end if; + return Is_Atomic (Entity (Selector_Name (N))); - return False; + else + return False; + end if; end Is_Atomic_Object; ----------------------------- @@ -13788,50 +13792,8 @@ package body Sem_Util is ----------------------------- function Is_Atomic_Or_VFA_Object (N : Node_Id) return Boolean is - function Is_VFA_Object (N : Node_Id) return Boolean; - -- Determine whether arbitrary node N denotes a reference to an object - -- that is Volatile_Full_Access. Modeled on Is_Atomic_Object above. - - function Is_VFA_Object_Entity (Id : Entity_Id) return Boolean; - -- Determine whether arbitrary entity Id denotes an object that is - -- Volatile_Full_Access. Modeled on Is_Atomic_Object_Entity above. - - --------------------- - -- Is_VFA_Object -- - --------------------- - - function Is_VFA_Object (N : Node_Id) return Boolean is - begin - if Is_Entity_Name (N) then - return Is_VFA_Object_Entity (Entity (N)); - - elsif Nkind (N) = N_Indexed_Component then - return Is_Volatile_Full_Access (Etype (N)); - - elsif Nkind (N) = N_Selected_Component then - return - Is_Volatile_Full_Access (Etype (N)) - or else Is_Volatile_Full_Access (Entity (Selector_Name (N))); - end if; - - return False; - end Is_VFA_Object; - - ---------------------------- - -- Is_VFA_Object_Entity -- - ---------------------------- - - function Is_VFA_Object_Entity (Id : Entity_Id) return Boolean is - begin - return - Is_Object (Id) - and then (Is_Volatile_Full_Access (Id) - or else - Is_Volatile_Full_Access (Etype (Id))); - end Is_VFA_Object_Entity; - begin - return Is_Atomic_Object (N) or else Is_VFA_Object (N); + return Is_Atomic_Object (N) or else Is_Volatile_Full_Access_Object (N); end Is_Atomic_Or_VFA_Object; ---------------------- @@ -15479,6 +15441,78 @@ package body Sem_Util is N_Generic_Subprogram_Declaration); end Is_Generic_Declaration_Or_Body; + --------------------------- + -- Is_Independent_Object -- + --------------------------- + + function Is_Independent_Object (N : Node_Id) return Boolean is + function Is_Independent_Object_Entity (Id : Entity_Id) return Boolean; + -- Determine whether arbitrary entity Id denotes an object that is + -- Independent. + + function Prefix_Has_Independent_Components (P : Node_Id) return Boolean; + -- Determine whether prefix P has independent components. This requires + -- the presence of an Independent_Components aspect/pragma. + + ------------------------------------ + -- Is_Independent_Object_Entity -- + ------------------------------------ + + function Is_Independent_Object_Entity (Id : Entity_Id) return Boolean is + begin + return + Is_Object (Id) + and then (Is_Independent (Id) + or else + Is_Independent (Etype (Id))); + end Is_Independent_Object_Entity; + + ------------------------------------- + -- Prefix_Has_Independent_Components -- + ------------------------------------- + + function Prefix_Has_Independent_Components (P : Node_Id) return Boolean + is + Typ : constant Entity_Id := Etype (P); + + begin + if Is_Access_Type (Typ) then + return Has_Independent_Components (Designated_Type (Typ)); + + elsif Has_Independent_Components (Typ) then + return True; + + elsif Is_Entity_Name (P) + and then Has_Independent_Components (Entity (P)) + then + return True; + + else + return False; + end if; + end Prefix_Has_Independent_Components; + + -- Start of processing for Is_Independent_Object + + begin + if Is_Entity_Name (N) then + return Is_Independent_Object_Entity (Entity (N)); + + elsif Is_Independent (Etype (N)) then + return True; + + elsif Nkind (N) = N_Indexed_Component then + return Prefix_Has_Independent_Components (Prefix (N)); + + elsif Nkind (N) = N_Selected_Component then + return Prefix_Has_Independent_Components (Prefix (N)) + or else Is_Independent (Entity (Selector_Name (N))); + + else + return False; + end if; + end Is_Independent_Object; + ---------------------------- -- Is_Inherited_Operation -- ---------------------------- @@ -17903,7 +17937,7 @@ package body Sem_Util is end if; else - if Is_Atomic (Etype (R)) or else Is_Atomic_Object (R) then + if Is_Atomic_Object (R) then return True; end if; end if; @@ -18545,6 +18579,45 @@ package body Sem_Util is and then Scope (Scope (Scope (Root))) = Standard_Standard; end Is_Visibly_Controlled; + -------------------------------------- + -- Is_Volatile_Full_Access_Object -- + -------------------------------------- + + function Is_Volatile_Full_Access_Object (N : Node_Id) return Boolean is + function Is_VFA_Object_Entity (Id : Entity_Id) return Boolean; + -- Determine whether arbitrary entity Id denotes an object that is + -- Volatile_Full_Access. + + ---------------------------- + -- Is_VFA_Object_Entity -- + ---------------------------- + + function Is_VFA_Object_Entity (Id : Entity_Id) return Boolean is + begin + return + Is_Object (Id) + and then (Is_Volatile_Full_Access (Id) + or else + Is_Volatile_Full_Access (Etype (Id))); + end Is_VFA_Object_Entity; + + -- Start of processing for Is_Volatile_Full_Access_Object + + begin + if Is_Entity_Name (N) then + return Is_VFA_Object_Entity (Entity (N)); + + elsif Is_Volatile_Full_Access (Etype (N)) then + return True; + + elsif Nkind (N) = N_Selected_Component then + return Is_Volatile_Full_Access (Entity (Selector_Name (N))); + + else + return False; + end if; + end Is_Volatile_Full_Access_Object; + -------------------------- -- Is_Volatile_Function -- -------------------------- @@ -18580,18 +18653,32 @@ package body Sem_Util is ------------------------ function Is_Volatile_Object (N : Node_Id) return Boolean is - function Is_Volatile_Prefix (N : Node_Id) return Boolean; - -- If prefix is an implicit dereference, examine designated type + function Is_Volatile_Object_Entity (Id : Entity_Id) return Boolean; + -- Determine whether arbitrary entity Id denotes an object that is + -- Volatile. - function Object_Has_Volatile_Components (N : Node_Id) return Boolean; - -- Determines if given object has volatile components + function Prefix_Has_Volatile_Components (P : Node_Id) return Boolean; + -- Determine whether prefix P has volatile components. This requires + -- the presence of a Volatile_Components aspect/pragma or that P be + -- itself a volatile object as per RM C.6(8). - ------------------------ - -- Is_Volatile_Prefix -- - ------------------------ + --------------------------------- + -- Is_Volatile_Object_Entity -- + --------------------------------- + + function Is_Volatile_Object_Entity (Id : Entity_Id) return Boolean is + begin + return + Is_Object (Id) + and then (Is_Volatile (Id) or else Is_Volatile (Etype (Id))); + end Is_Volatile_Object_Entity; - function Is_Volatile_Prefix (N : Node_Id) return Boolean is - Typ : constant Entity_Id := Etype (N); + ------------------------------------ + -- Prefix_Has_Volatile_Components -- + ------------------------------------ + + function Prefix_Has_Volatile_Components (P : Node_Id) return Boolean is + Typ : constant Entity_Id := Etype (P); begin if Is_Access_Type (Typ) then @@ -18599,67 +18686,41 @@ package body Sem_Util is Dtyp : constant Entity_Id := Designated_Type (Typ); begin - return Is_Volatile (Dtyp) - or else Has_Volatile_Components (Dtyp); + return Has_Volatile_Components (Dtyp) + or else Is_Volatile (Dtyp); end; - else - return Object_Has_Volatile_Components (N); - end if; - end Is_Volatile_Prefix; - - ------------------------------------ - -- Object_Has_Volatile_Components -- - ------------------------------------ - - function Object_Has_Volatile_Components (N : Node_Id) return Boolean is - Typ : constant Entity_Id := Etype (N); - - begin - if Is_Volatile (Typ) - or else Has_Volatile_Components (Typ) - then + elsif Has_Volatile_Components (Typ) then return True; - elsif Is_Entity_Name (N) - and then (Has_Volatile_Components (Entity (N)) - or else Is_Volatile (Entity (N))) + elsif Is_Entity_Name (P) + and then Has_Volatile_Component (Entity (P)) then return True; - elsif Nkind (N) = N_Indexed_Component - or else Nkind (N) = N_Selected_Component - then - return Is_Volatile_Prefix (Prefix (N)); + elsif Is_Volatile_Object (P) then + return True; else return False; end if; - end Object_Has_Volatile_Components; + end Prefix_Has_Volatile_Components; -- Start of processing for Is_Volatile_Object begin - if Nkind (N) = N_Defining_Identifier then - return Is_Volatile (N) or else Is_Volatile (Etype (N)); - - elsif Nkind (N) = N_Expanded_Name then - return Is_Volatile_Object (Entity (N)); + if Is_Entity_Name (N) then + return Is_Volatile_Object_Entity (Entity (N)); - elsif Is_Volatile (Etype (N)) - or else (Is_Entity_Name (N) and then Is_Volatile (Entity (N))) - then + elsif Is_Volatile (Etype (N)) then return True; - elsif Nkind_In (N, N_Indexed_Component, N_Selected_Component) - and then Is_Volatile_Prefix (Prefix (N)) - then - return True; + elsif Nkind (N) = N_Indexed_Component then + return Prefix_Has_Volatile_Components (Prefix (N)); - elsif Nkind (N) = N_Selected_Component - and then Is_Volatile (Entity (Selector_Name (N))) - then - return True; + elsif Nkind (N) = N_Selected_Component then + return Prefix_Has_Volatile_Components (Prefix (N)) + or else Is_Volatile (Entity (Selector_Name (N))); else return False; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index a665b5e..2882917 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1531,11 +1531,7 @@ package Sem_Util is function Is_Atomic_Object (N : Node_Id) return Boolean; -- Determine whether arbitrary node N denotes a reference to an atomic - -- object as per Ada RM C.6(7) and the crucial remark in C.6(8). - - function Is_Atomic_Object_Entity (Id : Entity_Id) return Boolean; - -- Determine whether arbitrary entity Id denotes an atomic object as per - -- Ada RM C.6(7). + -- object as per RM C.6(7) and the crucial remark in RM C.6(8). function Is_Atomic_Or_VFA_Object (N : Node_Id) return Boolean; -- Determine whether arbitrary node N denotes a reference to an object @@ -1749,6 +1745,10 @@ package Sem_Util is -- Determine whether arbitrary declaration Decl denotes a generic package, -- a generic subprogram or a generic body. + function Is_Independent_Object (N : Node_Id) return Boolean; + -- Determine whether arbitrary node N denotes a reference to an independent + -- object as per RM C.6(8). + function Is_Inherited_Operation (E : Entity_Id) return Boolean; -- E is a subprogram. Return True is E is an implicit operation inherited -- by a derived type declaration. @@ -1996,7 +1996,7 @@ package Sem_Util is function Is_Subcomponent_Of_Atomic_Object (N : Node_Id) return Boolean; -- Determine whether arbitrary node N denotes a reference to a subcomponent - -- of an atomic object as per Ada RM C.6(7). + -- of an atomic object as per RM C.6(7). function Is_Subprogram_Contract_Annotation (Item : Node_Id) return Boolean; -- Determine whether aspect specification or pragma Item is one of the @@ -2095,16 +2095,20 @@ package Sem_Util is -- Initialize/Adjust/Finalize subprogram does not override the inherited -- one. + function Is_Volatile_Full_Access_Object (N : Node_Id) return Boolean; + -- Determine whether arbitrary node N denotes a reference to an object + -- which is Volatile_Full_Access. + function Is_Volatile_Function (Func_Id : Entity_Id) return Boolean; -- Determine whether [generic] function Func_Id is subject to enabled -- pragma Volatile_Function. Protected functions are treated as volatile -- (SPARK RM 7.1.2). function Is_Volatile_Object (N : Node_Id) return Boolean; - -- Determines if the given node denotes an volatile object in the sense of - -- the legality checks described in RM C.6(12). Note that the test here is - -- for something actually declared as volatile, not for an object that gets - -- treated as volatile (see Einfo.Treat_As_Volatile). + -- Determine whether arbitrary node N denotes a reference to a volatile + -- object as per RM C.6(8). Note that the test here is for something that + -- is actually declared as volatile, not for an object that gets treated + -- as volatile (see Einfo.Treat_As_Volatile). generic with procedure Handle_Parameter (Formal : Entity_Id; Actual : Node_Id); |