[multiple changes]

2017-04-25  Eric Botcazou  <ebotcazou@adacore.com>

	* 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  <duff@adacore.com>

	* 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  <dismukes@adacore.com>

	* exp_dbug.adb: Minor rewording and reformatting.

2017-04-25  Ed Schonberg  <schonberg@adacore.com>

	* 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

1 files changed, 66 insertions, 1 deletions

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 --
    --------------------------------