From 2df23f66e28fe9b4c9d533a650c9d65e20b4b1ba Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 25 Apr 2017 11:42:56 +0200 Subject: [multiple changes] 2017-04-25 Eric Botcazou * exp_ch4.adb (Library_Level_Target): New function. (Expand_Concatenate): When optimization is enabled, also expand the operation out-of-line if the concatenation is present within the expression of the declaration of a library-level object and not only if it is the expression of the declaration. 2017-04-25 Bob Duff * freeze.adb (Freeze_Object_Declaration): Do not Remove_Side_Effects if there is a pragma Linker_Section, because in that case we want static initialization in the appropriate section. 2017-04-25 Gary Dismukes * exp_dbug.adb: Minor rewording and reformatting. 2017-04-25 Ed Schonberg * sem_attr.adb (Statically_Denotes_Object): New predicate, to handle the proposed changes to rules concerning potentially unevaluated expressions, to include selected components that do not depend on discriminants, and indexed components with static indices. * sem_util.adb (Is_Potentially_Unevaluated): Add check for predicate in quantified expression, and fix bugs in the handling of case expressions and membership test. (Analyze_Attribute_Old_Result): use new predicate. (Analyze_Attribute, case Loop_Entry): ditto. From-SVN: r247167 --- gcc/ada/sem_attr.adb | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 66 insertions(+), 1 deletion(-) (limited to 'gcc/ada/sem_attr.adb') diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 1d25da7..833cb8e 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -210,6 +210,15 @@ package body Sem_Attr is -- Standard_True, depending on the value of the parameter B. The -- result is marked as a static expression. + function Statically_Denotes_Object (N : Node_Id) return Boolean; + -- Predicate used to check the legality of the prefix to 'Loop_Entry and + -- 'Old, when the prefix is not an entity name. Current RM specfies that + -- the prefix must be a direct or expanded name, but it has been proposed + -- that the prefix be allowed to be a selected component that does not + -- depend on a discriminant, or an indexed component with static indices. + -- Current code for this predicate implements this more permissive + -- implementation. + ----------------------- -- Analyze_Attribute -- ----------------------- @@ -4501,6 +4510,7 @@ package body Sem_Attr is if Is_Entity_Name (P) or else Nkind (Parent (P)) = N_Object_Renaming_Declaration + or else Statically_Denotes_Object (P) then null; @@ -4999,7 +5009,9 @@ package body Sem_Attr is -- Ensure that the prefix of attribute 'Old is an entity when it -- is potentially unevaluated (6.1.1 (27/3)). - if Is_Potentially_Unevaluated (N) then + if Is_Potentially_Unevaluated (N) + and then not Statically_Denotes_Object (P) + then Uneval_Old_Msg; -- Detect a possible infinite recursion when the prefix denotes @@ -11808,6 +11820,59 @@ package body Sem_Attr is end if; end Set_Boolean_Result; + ------------------------------- + -- Statically_Denotes_Object -- + ------------------------------- + + function Statically_Denotes_Object (N : Node_Id) return Boolean is + Indx : Node_Id; + + begin + if Is_Entity_Name (N) then + return True; + + elsif Nkind (N) = N_Selected_Component + and then Statically_Denotes_Object (Prefix (N)) + and then Present (Entity (Selector_Name (N))) + then + declare + Sel_Id : constant Entity_Id := Entity (Selector_Name (N)); + Comp_Decl : constant Node_Id := Parent (Sel_Id); + + begin + if Depends_On_Discriminant (Sel_Id) then + return False; + + elsif Nkind (Parent (Parent (Comp_Decl))) = N_Variant then + return False; + + else + return True; + end if; + end; + + elsif Nkind (N) = N_Indexed_Component + and then Statically_Denotes_Object (Prefix (N)) + and then Is_Constrained (Etype (Prefix (N))) + then + Indx := First (Expressions (N)); + while Present (Indx) loop + if not Compile_Time_Known_Value (Indx) + or else Do_Range_Check (Indx) + then + return False; + end if; + + Next (Indx); + end loop; + + return True; + + else + return False; + end if; + end Statically_Denotes_Object; + -------------------------------- -- Stream_Attribute_Available -- -------------------------------- -- cgit v1.1