[multiple changes]

2015-05-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Add_Internal_Interface_Entities): Do no generate
	freeze nodes for these in ASIS mode, because they lead to
	elaoration order issues in gigi.

2015-05-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch6.adb (Analyze_Expression_Function): Code
	cleanup. Use Copy_Subprogram_Spec to create a proper spec.
	(Analyze_Subprogram_Body_Helper): Code cleanup. Do not
	prepare a stand alone body for inlining in GNATprove mode
	when inside a generic.	(Body_Has_Contract): Reimplemented.
	(Build_Subprogram_Declaration): New routine.
	* sem_ch10.adb (Analyze_Compilation_Unit): Capture global
	references within generic bodies by loading them.
	* sem_util.adb (Copy_Parameter_List): Code cleanup.
	(Copy_Subprogram_Spec): New routine.
	(Is_Contract_Annotation): New routine.
	* sem_util.ads (Copy_Subprogram_Spec): New routine.
	(Is_Contract_Annotation): New routine.

2015-05-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_attr.adb (Resolve_Attribute): Do not analyze the generated
	body of an expression function when the prefix of attribute
	'Access is the body.

From-SVN: r223048

gcc/ada/ChangeLog

 2015-05-12  Ed Schonberg  <schonberg@adacore.com>
 
+	* sem_ch3.adb (Add_Internal_Interface_Entities): Do no generate
+	freeze nodes for these in ASIS mode, because they lead to
+	elaoration order issues in gigi.
+
+2015-05-12  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch6.adb (Analyze_Expression_Function): Code
+	cleanup. Use Copy_Subprogram_Spec to create a proper spec.
+	(Analyze_Subprogram_Body_Helper): Code cleanup. Do not
+	prepare a stand alone body for inlining in GNATprove mode
+	when inside a generic.	(Body_Has_Contract): Reimplemented.
+	(Build_Subprogram_Declaration): New routine.
+	* sem_ch10.adb (Analyze_Compilation_Unit): Capture global
+	references within generic bodies by loading them.
+	* sem_util.adb (Copy_Parameter_List): Code cleanup.
+	(Copy_Subprogram_Spec): New routine.
+	(Is_Contract_Annotation): New routine.
+	* sem_util.ads (Copy_Subprogram_Spec): New routine.
+	(Is_Contract_Annotation): New routine.
+
+2015-05-12  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_attr.adb (Resolve_Attribute): Do not analyze the generated
+	body of an expression function when the prefix of attribute
+	'Access is the body.
+
+2015-05-12  Ed Schonberg  <schonberg@adacore.com>
+
 	* sem_ch3.adb (Build_Derived_Enumeration_Type): The anonymous base
 	created for a derived enumeration type is not a first subtype,
 	even though it is defined through a full type declaration.

gcc/ada/sem_attr.adb

@@ -10675,13 +10675,31 @@ package body Sem_Attr is
                      Subp_Body :=
                        Unit_Declaration_Node (Corresponding_Body (Subp_Decl));
 
-                     --  Analyze the body of the expression function to freeze
-                     --  the expression. This takes care of the case where the
-                     --  'Access is part of dispatch table initialization and
-                     --  the generated body of the expression function has not
-                     --  been analyzed yet.
+                     --  The body has already been analyzed when the expression
+                     --  function acts as a completion.
 
-                     if not Analyzed (Subp_Body) then
+                     if Analyzed (Subp_Body) then
+                        null;
+
+                     --  Attribute 'Access may appear within the generated body
+                     --  of the expression function subject to the attribute:
+
+                     --    function F is (... F'Access ...);
+
+                     --  If the expression function is on the scope stack, then
+                     --  the body is currently being analyzed. Do not reanalyze
+                     --  it because this will lead to infinite recursion.
+
+                     elsif In_Open_Scopes (Subp_Id) then
+                        null;
+
+                      --  Analyze the body of the expression function to freeze
+                      --  the expression. This takes care of the case where the
+                      --  'Access is part of dispatch table initialization and
+                      --  the generated body of the expression function has not
+                      --  been analyzed yet.
+
+                     else
                         Analyze (Subp_Body);
                      end if;
                   end if;

gcc/ada/sem_ch10.adb

@@ -1020,16 +1020,18 @@ package body Sem_Ch10 is
 
       Remove_Context (N);
 
-      --  If this is the main unit and we are generating code, we must check
-      --  that all generic units in the context have a body if they need it,
-      --  even if they have not been instantiated. In the absence of .ali files
-      --  for generic units, we must force the load of the body, just to
-      --  produce the proper error if the body is absent. We skip this
-      --  verification if the main unit itself is generic.
+      --  When generating code for a non-generic main unit, check that withed
+      --  generic units have a body if they need it, even if the units have not
+      --  been instantiated. Force the load of the bodies to produce the proper
+      --  error if the body is absent. The same applies to GNATprove mode, with
+      --  the added benefit of capturing global references within the generic.
+      --  This in turn allows for proper inlining of subprogram bodies without
+      --  a previous declaration.
 
       if Get_Cunit_Unit_Number (N) = Main_Unit
-        and then Operating_Mode = Generate_Code
-        and then Expander_Active
+        and then ((Operating_Mode = Generate_Code and then Expander_Active)
+                     or else
+                  (Operating_Mode = Check_Semantics and then GNATprove_Mode))
       then
          --  Check whether the source for the body of the unit must be included
          --  in a standalone library.
@@ -1066,7 +1068,7 @@ package body Sem_Ch10 is
                then
                   Nam := Entity (Name (Item));
 
-                  --  Compile generic subprogram, unless it is intrinsic or
+                  --  Compile the generic subprogram, unless it is intrinsic or
                   --  imported so no body is required, or generic package body
                   --  if the package spec requires a body.
 
@@ -1080,20 +1082,21 @@ package body Sem_Ch10 is
 
                      if Present (Renamed_Object (Nam)) then
                         Un :=
-                           Load_Unit
-                             (Load_Name  => Get_Body_Name
-                                              (Get_Unit_Name
-                                                (Unit_Declaration_Node
-                                                  (Renamed_Object (Nam)))),
-                              Required   => False,
-                              Subunit    => False,
-                              Error_Node => N,
-                              Renamings  => True);
+                          Load_Unit
+                            (Load_Name  =>
+                               Get_Body_Name
+                                 (Get_Unit_Name
+                                   (Unit_Declaration_Node
+                                     (Renamed_Object (Nam)))),
+                             Required   => False,
+                             Subunit    => False,
+                             Error_Node => N,
+                             Renamings  => True);
                      else
                         Un :=
                           Load_Unit
-                            (Load_Name  => Get_Body_Name
-                                             (Get_Unit_Name (Item)),
+                            (Load_Name  =>
+                               Get_Body_Name (Get_Unit_Name (Item)),
                              Required   => False,
                              Subunit    => False,
                              Error_Node => N,

gcc/ada/sem_ch3.adb

@@ -1772,9 +1772,13 @@ package body Sem_Ch3 is
                --  locally defined tagged types (or compiling with static
                --  dispatch tables generation disabled) the corresponding
                --  entry of the secondary dispatch table is filled when
-               --  such an entity is frozen.
+               --  such an entity is frozen. This is an expansion activity
+               --  that must be suppressed for ASIS because it leads to
+               --  gigi elaboration issues in annotate mode.
 
-               Set_Has_Delayed_Freeze (New_Subp);
+               if not ASIS_Mode then
+                  Set_Has_Delayed_Freeze (New_Subp);
+               end if;
             end if;
 
             <<Continue>>
@@ -1794,7 +1798,7 @@ package body Sem_Ch3 is
    -----------------------------------
 
    procedure Analyze_Component_Declaration (N : Node_Id) is
-      Loc : constant Source_Ptr := Sloc (N);
+      Loc : constant Source_Ptr := Sloc (Component_Definition (N));
       Id  : constant Entity_Id  := Defining_Identifier (N);
       E   : constant Node_Id    := Expression (N);
       Typ : constant Node_Id    :=
@@ -2137,9 +2141,14 @@ package body Sem_Ch3 is
       then
          declare
             Act_T : constant Entity_Id := Build_Default_Subtype (T, N);
+
          begin
             Set_Etype (Id, Act_T);
-            Set_Component_Definition (N,
+
+            --  Rewrite the component definition to use the constrained
+            --  subtype.
+
+            Rewrite (Component_Definition (N),
               Make_Component_Definition (Loc,
                 Subtype_Indication => New_Occurrence_Of (Act_T, Loc)));
          end;

gcc/ada/sem_util.adb

@@ -4412,21 +4412,19 @@ package body Sem_Util is
       if No (First_Formal (Subp_Id)) then
          return No_List;
       else
-         Plist := New_List;
+         Plist  := New_List;
          Formal := First_Formal (Subp_Id);
          while Present (Formal) loop
-            Append
-              (Make_Parameter_Specification (Loc,
+            Append_To (Plist,
+              Make_Parameter_Specification (Loc,
                 Defining_Identifier =>
-                  Make_Defining_Identifier (Sloc (Formal),
-                    Chars => Chars (Formal)),
-                In_Present  => In_Present (Parent (Formal)),
-                Out_Present => Out_Present (Parent (Formal)),
-             Parameter_Type =>
+                  Make_Defining_Identifier (Sloc (Formal), Chars (Formal)),
+                In_Present          => In_Present (Parent (Formal)),
+                Out_Present         => Out_Present (Parent (Formal)),
+                Parameter_Type      =>
                   New_Occurrence_Of (Etype (Formal), Loc),
-                Expression =>
-                  New_Copy_Tree (Expression (Parent (Formal)))),
-              Plist);
+                Expression          =>
+                  New_Copy_Tree (Expression (Parent (Formal)))));
 
             Next_Formal (Formal);
          end loop;
@@ -4435,6 +4433,43 @@ package body Sem_Util is
       return Plist;
    end Copy_Parameter_List;
 
+   --------------------------
+   -- Copy_Subprogram_Spec --
+   --------------------------
+
+   function Copy_Subprogram_Spec (Spec : Node_Id) return Node_Id is
+      Def_Id      : Node_Id;
+      Formal_Spec : Node_Id;
+      Result      : Node_Id;
+
+   begin
+      --  The structure of the original tree must be replicated without any
+      --  alterations. Use New_Copy_Tree for this purpose.
+
+      Result := New_Copy_Tree (Spec);
+
+      --  Create a new entity for the defining unit name
+
+      Def_Id := Defining_Unit_Name (Result);
+      Set_Defining_Unit_Name (Result,
+        Make_Defining_Identifier (Sloc (Def_Id), Chars (Def_Id)));
+
+      --  Create new entities for the formal parameters
+
+      if Present (Parameter_Specifications (Result)) then
+         Formal_Spec := First (Parameter_Specifications (Result));
+         while Present (Formal_Spec) loop
+            Def_Id := Defining_Identifier (Formal_Spec);
+            Set_Defining_Identifier (Formal_Spec,
+              Make_Defining_Identifier (Sloc (Def_Id), Chars (Def_Id)));
+
+            Next (Formal_Spec);
+         end loop;
+      end if;
+
+      return Result;
+   end Copy_Subprogram_Spec;
+
    --------------------------------
    -- Corresponding_Generic_Type --
    --------------------------------
@@ -10299,6 +10334,29 @@ package body Sem_Util is
             or else Is_Task_Interface (T));
    end Is_Concurrent_Interface;
 
+   -----------------------
+   -- Is_Constant_Bound --
+   -----------------------
+
+   function Is_Constant_Bound (Exp : Node_Id) return Boolean is
+   begin
+      if Compile_Time_Known_Value (Exp) then
+         return True;
+
+      elsif Is_Entity_Name (Exp) and then Present (Entity (Exp)) then
+         return Is_Constant_Object (Entity (Exp))
+           or else Ekind (Entity (Exp)) = E_Enumeration_Literal;
+
+      elsif Nkind (Exp) in N_Binary_Op then
+         return Is_Constant_Bound (Left_Opnd (Exp))
+           and then Is_Constant_Bound (Right_Opnd (Exp))
+           and then Scope (Entity (Exp)) = Standard_Standard;
+
+      else
+         return False;
+      end if;
+   end Is_Constant_Bound;
+
    ---------------------------
    --  Is_Container_Element --
    ---------------------------
@@ -10478,28 +10536,40 @@ package body Sem_Util is
       end;
    end Is_Container_Element;
 
-   -----------------------
-   -- Is_Constant_Bound --
-   -----------------------
-
-   function Is_Constant_Bound (Exp : Node_Id) return Boolean is
-   begin
-      if Compile_Time_Known_Value (Exp) then
-         return True;
+   ----------------------------
+   -- Is_Contract_Annotation --
+   ----------------------------
 
-      elsif Is_Entity_Name (Exp) and then Present (Entity (Exp)) then
-         return Is_Constant_Object (Entity (Exp))
-           or else Ekind (Entity (Exp)) = E_Enumeration_Literal;
+   function Is_Contract_Annotation (Item : Node_Id) return Boolean is
+      Nam : Name_Id;
 
-      elsif Nkind (Exp) in N_Binary_Op then
-         return Is_Constant_Bound (Left_Opnd (Exp))
-           and then Is_Constant_Bound (Right_Opnd (Exp))
-           and then Scope (Entity (Exp)) = Standard_Standard;
+   begin
+      if Nkind (Item) = N_Aspect_Specification then
+         Nam := Chars (Identifier (Item));
 
-      else
-         return False;
+      else pragma Assert (Nkind (Item) = N_Pragma);
+         Nam := Pragma_Name (Item);
       end if;
-   end Is_Constant_Bound;
+
+      return
+        Nam = Name_Abstract_State
+          or else Nam = Name_Contract_Cases
+          or else Nam = Name_Depends
+          or else Nam = Name_Extensions_Visible
+          or else Nam = Name_Global
+          or else Nam = Name_Initial_Condition
+          or else Nam = Name_Initializes
+          or else Nam = Name_Post
+          or else Nam = Name_Post_Class
+          or else Nam = Name_Postcondition
+          or else Nam = Name_Pre
+          or else Nam = Name_Pre_Class
+          or else Nam = Name_Precondition
+          or else Nam = Name_Refined_Depends
+          or else Nam = Name_Refined_Global
+          or else Nam = Name_Refined_State
+          or else Nam = Name_Test_Case;
+   end Is_Contract_Annotation;
 
    --------------------------------------
    -- Is_Controlling_Limited_Procedure --

gcc/ada/sem_util.ads

@@ -397,12 +397,6 @@ package Sem_Util is
    --    Depends
    --    Global
 
-   function Copy_Parameter_List (Subp_Id : Entity_Id) return List_Id;
-   --  Utility to create a parameter profile for a new subprogram spec, when
-   --  the subprogram has a body that acts as spec. This is done for some cases
-   --  of inlining, and for private protected ops. Also used to create bodies
-   --  for stubbed subprograms.
-
    function Copy_Component_List
      (R_Typ : Entity_Id;
       Loc   : Source_Ptr) return List_Id;
@@ -410,6 +404,17 @@ package Sem_Util is
    --  create a new compatible record type. Loc is the source location assigned
    --  to the created nodes.
 
+   function Copy_Parameter_List (Subp_Id : Entity_Id) return List_Id;
+   --  Utility to create a parameter profile for a new subprogram spec, when
+   --  the subprogram has a body that acts as spec. This is done for some cases
+   --  of inlining, and for private protected ops. Also used to create bodies
+   --  for stubbed subprograms.
+
+   function Copy_Subprogram_Spec (Spec : Node_Id) return Node_Id;
+   --  Replicate a function or a procedure specification denoted by Spec. The
+   --  resulting tree is an exact duplicate of the original tree. New entities
+   --  are created for the unit name and the formal parameters.
+
    function Corresponding_Generic_Type (T : Entity_Id) return Entity_Id;
    --  If a type is a generic actual type, return the corresponding formal in
    --  the generic parent unit. There is no direct link in the tree for this
@@ -1186,6 +1191,10 @@ package Sem_Util is
    --  explicit dereference. The transformation applies when it has the form
    --  F (X).Discr.all.
 
+   function Is_Contract_Annotation (Item : Node_Id) return Boolean;
+   --  Determine whether aspect specification or pragma Item is a contract
+   --  annotation.
+
    function Is_Controlling_Limited_Procedure
      (Proc_Nam : Entity_Id) return Boolean;
    --  Ada 2005 (AI-345): Determine whether Proc_Nam is a primitive procedure