From 2757c5bf1817db84c51f0297ae8c27acfaea2ad3 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 27 Jan 2014 17:49:44 +0100 Subject: [multiple changes] 2014-01-27 Hristian Kirtchev * einfo.adb (Has_Option): Reimplemented. * sem_prag.adb (Analyze_Refinement_Clause): Add global variables AR_Constit, AW_Constit, ER_Constit, EW_Constit, External_Constit_Seen and State. Add local variables Body_Ref, Body_Ref_Elmt and Extra_State. Reimplement part of the logic to avoid a cumbersome while pool. Verify the legality of an external state and relevant properties. (Check_External_Property): New routine. (Check_Matching_State): Remove parameter profile and update comment on usage. (Collect_Constituent): Store the relevant external property of a constituent. * sem_util.adb (Async_Readers_Enabled): Update the call to Has_Enabled_Property. (Async_Writers_Enabled): Update the call to Has_Enabled_Property. (Effective_Reads_Enabled): Update the call to Has_Enabled_Property. (Effective_Writes_Enabled): Update the call to Has_Enabled_Property. (Has_Enabled_Property): Rename formal parameter Extern to State_Id. Update comment on usage. Reimplement the logic to recognize the various formats of properties. 2014-01-27 Ed Schonberg * par-ch5.adb: Minor reformatting. 2014-01-27 Tristan Gingold * s-tposen.ads: Harmonize style and comments. 2014-01-27 Vincent Celier * projects.texi: Document that shared library projects, by default, cannot import projects that are not shared library projects. 2014-01-27 Robert Dewar * sem_ch8.adb (Find_Selected_Component): Use Replace instead of Rewrite. 2014-01-27 Ed Schonberg * a-suenco.adb, a-suenst.adb (Decode): Raise encoding error if any other exception is raised. (Convert): If both Input_Scheme and Output_Scheme are UTF_8 it is still necessary to perform a conversion in order to remove overlong encodings. From-SVN: r207142 --- gcc/ada/sem_util.adb | 121 +++++++++++++++++++++++++++------------------------ 1 file changed, 63 insertions(+), 58 deletions(-) (limited to 'gcc/ada/sem_util.adb') diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 284872b..8fc28ef 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -114,11 +114,11 @@ package body Sem_Util is -- have a default. function Has_Enabled_Property - (Extern : Node_Id; + (State_Id : Node_Id; Prop_Nam : Name_Id) return Boolean; -- Subsidiary to routines Async_xxx_Enabled and Effective_xxx_Enabled. - -- Given pragma External, determine whether it contains a property denoted - -- by its name Prop_Nam and if it does, whether its expression is True. + -- Determine whether an abstract state denoted by its entity State_Id has + -- enabled property Prop_Name. function Has_Null_Extension (T : Entity_Id) return Boolean; -- T is a derived tagged type. Check whether the type extension is null. @@ -560,10 +560,7 @@ package body Sem_Util is function Async_Readers_Enabled (Id : Entity_Id) return Boolean is begin if Ekind (Id) = E_Abstract_State then - return - Has_Enabled_Property - (Extern => Get_Pragma (Id, Pragma_External), - Prop_Nam => Name_Async_Readers); + return Has_Enabled_Property (Id, Name_Async_Readers); else pragma Assert (Ekind (Id) = E_Variable); return Present (Get_Pragma (Id, Pragma_Async_Readers)); @@ -577,10 +574,7 @@ package body Sem_Util is function Async_Writers_Enabled (Id : Entity_Id) return Boolean is begin if Ekind (Id) = E_Abstract_State then - return - Has_Enabled_Property - (Extern => Get_Pragma (Id, Pragma_External), - Prop_Nam => Name_Async_Writers); + return Has_Enabled_Property (Id, Name_Async_Writers); else pragma Assert (Ekind (Id) = E_Variable); return Present (Get_Pragma (Id, Pragma_Async_Writers)); @@ -4818,10 +4812,7 @@ package body Sem_Util is function Effective_Reads_Enabled (Id : Entity_Id) return Boolean is begin if Ekind (Id) = E_Abstract_State then - return - Has_Enabled_Property - (Extern => Get_Pragma (Id, Pragma_External), - Prop_Nam => Name_Effective_Reads); + return Has_Enabled_Property (Id, Name_Effective_Reads); else pragma Assert (Ekind (Id) = E_Variable); return Present (Get_Pragma (Id, Pragma_Effective_Reads)); @@ -4835,10 +4826,7 @@ package body Sem_Util is function Effective_Writes_Enabled (Id : Entity_Id) return Boolean is begin if Ekind (Id) = E_Abstract_State then - return - Has_Enabled_Property - (Extern => Get_Pragma (Id, Pragma_External), - Prop_Nam => Name_Effective_Writes); + return Has_Enabled_Property (Id, Name_Effective_Writes); else pragma Assert (Ekind (Id) = E_Variable); return Present (Get_Pragma (Id, Pragma_Effective_Writes)); @@ -7182,69 +7170,86 @@ package body Sem_Util is -------------------------- function Has_Enabled_Property - (Extern : Node_Id; + (State_Id : Node_Id; Prop_Nam : Name_Id) return Boolean is - Prop : Node_Id; - Props : Node_Id := Empty; + Decl : constant Node_Id := Parent (State_Id); + Opt : Node_Id; + Opt_Nam : Node_Id; + Prop : Node_Id; + Props : Node_Id; begin - -- The related abstract state or variable do not have an Extern pragma, - -- the property in question cannot be set. + -- The declaration of an external abstract state appears as an extension + -- aggregate. If this is not the case, properties can never be set. - if No (Extern) then + if Nkind (Decl) /= N_Extension_Aggregate then return False; - - elsif Nkind (Extern) = N_Component_Association then - Props := Expression (Extern); end if; - -- External state with properties + -- When External appears as a simple option, it automatically enables + -- all properties. - if Present (Props) then + Opt := First (Expressions (Decl)); + while Present (Opt) loop + if Nkind (Opt) = N_Identifier + and then Chars (Opt) = Name_External + then + return True; + end if; - -- Multiple properties appear as an aggregate + Next (Opt); + end loop; - if Nkind (Props) = N_Aggregate then + -- When External specifies particular properties, inspect those and + -- find the desired one (if any). - -- Simple property form + Opt := First (Component_Associations (Decl)); + while Present (Opt) loop + Opt_Nam := First (Choices (Opt)); - Prop := First (Expressions (Props)); - while Present (Prop) loop - if Chars (Prop) = Prop_Nam then - return True; - end if; + if Nkind (Opt_Nam) = N_Identifier + and then Chars (Opt_Nam) = Name_External + then + Props := Expression (Opt); - Next (Prop); - end loop; + -- Multiple properties appear as an aggregate - -- Property with expression form + if Nkind (Props) = N_Aggregate then - Prop := First (Component_Associations (Props)); - while Present (Prop) loop - if Chars (Prop) = Prop_Nam then - return Is_True (Expr_Value (Expression (Prop))); - end if; + -- Simple property form - Next (Prop); - end loop; + Prop := First (Expressions (Props)); + while Present (Prop) loop + if Chars (Prop) = Prop_Nam then + return True; + end if; + + Next (Prop); + end loop; - -- Pragma Extern contains properties, but not the one we want + -- Property with expression form - return False; + Prop := First (Component_Associations (Props)); + while Present (Prop) loop + if Chars (Prop) = Prop_Nam then + return Is_True (Expr_Value (Expression (Prop))); + end if; + + Next (Prop); + end loop; - -- Single property + -- Single property - else - return Chars (Prop) = Prop_Nam; + else + return Chars (Prop) = Prop_Nam; + end if; end if; - -- An external state defined without any properties defaults all - -- properties to True; + Next (Opt); + end loop; - else - return True; - end if; + return False; end Has_Enabled_Property; -------------------- -- cgit v1.1