[multiple changes]

2016-06-16  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Check_Entry_Contracts): New procedure, subsidiary
	of Analyze_Declarations, that performs pre-analysis of
	pre/postconditions on entry declarations before full analysis
	is performed after entries have been converted into procedures.
	Done solely to capture semantic errors.
	* sem_attr.adb (Analyze_Attribute, case 'Result): Add guard to
	call to Denote_Same_Function.

2016-06-16  Emmanuel Briot  <briot@adacore.com>

	* g-comlin.adb: Fix minor memory leak in GNAT.Command_Line.

2016-06-16  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Find_Last_Init): Remove obsolete code. The
	logic is now performed by Process_Object_Declaration.
	(Process_Declarations): Recognize a controlled deferred
	constant which is in fact initialized by means of a
	build-in-place function call as needing finalization actions.
	(Process_Object_Declaration): Insert the counter after the
	build-in-place initialization call for a controlled object. This
	was previously done in Find_Last_Init.
	* exp_util.adb (Requires_Cleanup_Actions): Recognize a controlled
	deferred constant which is in fact initialized by means of a
	build-in-place function call as needing finalization actions.

2016-06-16  Justin Squirek  <squirek@adacore.com>

	* exp_aggr.adb (Expand_Array_Aggregate): Minor comment changes and
	additional style fixes.
	* exp_ch7.adb: Minor typo fixes and reformatting.

From-SVN: r237515

7 files changed, 163 insertions, 81 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index dc34b75..5f24e35 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,37 @@
+2016-06-16  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Check_Entry_Contracts): New procedure, subsidiary
+	of Analyze_Declarations, that performs pre-analysis of
+	pre/postconditions on entry declarations before full analysis
+	is performed after entries have been converted into procedures.
+	Done solely to capture semantic errors.
+	* sem_attr.adb (Analyze_Attribute, case 'Result): Add guard to
+	call to Denote_Same_Function.
+
+2016-06-16  Emmanuel Briot  <briot@adacore.com>
+
+	* g-comlin.adb: Fix minor memory leak in GNAT.Command_Line.
+
+2016-06-16  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch7.adb (Find_Last_Init): Remove obsolete code. The
+	logic is now performed by Process_Object_Declaration.
+	(Process_Declarations): Recognize a controlled deferred
+	constant which is in fact initialized by means of a
+	build-in-place function call as needing finalization actions.
+	(Process_Object_Declaration): Insert the counter after the
+	build-in-place initialization call for a controlled object. This
+	was previously done in Find_Last_Init.
+	* exp_util.adb (Requires_Cleanup_Actions): Recognize a controlled
+	deferred constant which is in fact initialized by means of a
+	build-in-place function call as needing finalization actions.
+
+2016-06-16  Justin Squirek  <squirek@adacore.com>
+
+	* exp_aggr.adb (Expand_Array_Aggregate): Minor comment changes and
+	additional style fixes.
+	* exp_ch7.adb: Minor typo fixes and reformatting.
+
 2016-06-16  Justin Squirek  <squirek@adacore.com>
 
 	* sem_ch3.adb (Analyze_Object_Declaration): Add a missing check
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index c75cafc..c3949df 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -5517,20 +5517,21 @@ package body Exp_Aggr is
       --  object. (Note: we don't use a block statement because this would
       --  cause generated freeze nodes to be elaborated in the wrong scope).
 
-      --  Should document these individual tests ???
+      --  Do not perform in-place expansion for SPARK 05 because aggregates are
+      --  expected to appear in qualified form. In-place expansion eliminates
+      --  the qualification and eventually violates this SPARK 05 restiction.
 
-      if not Has_Default_Init_Comps (N)
-         and then Comes_From_Source (Parent_Node)
-         and then Parent_Kind = N_Object_Declaration
-         and then not
-           Must_Slide (Etype (Defining_Identifier (Parent_Node)), Typ)
-         and then Present (Expression (Parent_Node))
-         and then not Has_Controlled_Component (Typ)
-         and then not Is_Bit_Packed_Array (Typ)
-
-         --  ??? the test for SPARK 05 needs documentation
+      --  Should document the rest of the guards ???
 
-         and then not Restriction_Check_Required (SPARK_05)
+      if not Has_Default_Init_Comps (N)
+        and then Comes_From_Source (Parent_Node)
+        and then Parent_Kind = N_Object_Declaration
+        and then Present (Expression (Parent_Node))
+        and then not
+          Must_Slide (Etype (Defining_Identifier (Parent_Node)), Typ)
+        and then not Has_Controlled_Component (Typ)
+        and then not Is_Bit_Packed_Array (Typ)
+        and then not Restriction_Check_Required (SPARK_05)
       then
          In_Place_Assign_OK_For_Declaration := True;
          Tmp := Defining_Identifier (Parent_Node);
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index a166b80..d6c1737 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -2100,16 +2100,21 @@ package body Exp_Ch7 is
                   null;
 
                --  The object is of the form:
-               --    Obj : Typ [:= Expr];
+               --    Obj : [constant] Typ [:= Expr];
 
-               --  Do not process the incomplete view of a deferred constant.
-               --  Do not consider tag-to-class-wide conversions.
+               --  Do not process tag-to-class-wide conversions because they do
+               --  not yield an object. Do not process the incomplete view of a
+               --  deferred constant. Note that an object initialized by means
+               --  of a build-in-place function call may appear as a deferred
+               --  constant after expansion activities. These kinds of objects
+               --  must be finalized.
 
                elsif not Is_Imported (Obj_Id)
                  and then Needs_Finalization (Obj_Typ)
-                 and then not (Ekind (Obj_Id) = E_Constant
-                                and then not Has_Completion (Obj_Id))
                  and then not Is_Tag_To_Class_Wide_Conversion (Obj_Id)
+                 and then not (Ekind (Obj_Id) = E_Constant
+                                and then not Has_Completion (Obj_Id)
+                                and then No (BIP_Initialization_Call (Obj_Id)))
                then
                   Processing_Actions;
 
@@ -2757,48 +2762,9 @@ package body Exp_Ch7 is
 
             Stmt := Next_Suitable_Statement (Decl);
 
-            --  A limited controlled object initialized by a function call uses
-            --  the build-in-place machinery to obtain its value.
-
-            --    Obj : Lim_Controlled_Type := Func_Call;
-
-            --  is expanded into
-
-            --    Obj  : Lim_Controlled_Type;
-            --    type Ptr_Typ is access Lim_Controlled_Type;
-            --    Temp : constant Ptr_Typ :=
-            --             Func_Call
-            --               (BIPalloc  => 1,
-            --                BIPaccess => Obj'Unrestricted_Access)'reference;
-
-            --  In this scenario the declaration of the temporary acts as the
-            --  last initialization statement.
-
-            if Is_Limited_Type (Obj_Typ)
-              and then Has_Init_Expression (Decl)
-              and then No (Expression (Decl))
-            then
-               while Present (Stmt) loop
-                  if Nkind (Stmt) = N_Object_Declaration
-                    and then Present (Expression (Stmt))
-                    and then Is_Object_Access_BIP_Func_Call
-                               (Expr   => Expression (Stmt),
-                                Obj_Id => Obj_Id)
-                  then
-                     Last_Init := Stmt;
-                     exit;
-                  end if;
-
-                  Next (Stmt);
-               end loop;
-
-            --  Nothing to do for an object with supporessed initialization.
-            --  Note that this check is not performed at the beginning of the
-            --  routine because a declaration marked with No_Initialization
-            --  may still be initialized by a build-in-place call (the case
-            --  above).
+            --  Nothing to do for an object with suppressed initialization
 
-            elsif No_Initialization (Decl) then
+            if No_Initialization (Decl) then
                return;
 
             --  In all other cases the initialization calls follow the related
@@ -2937,18 +2903,33 @@ package body Exp_Ch7 is
              Expression => Make_Integer_Literal (Loc, Counter_Val));
 
          --  Insert the counter after all initialization has been done. The
-         --  place of insertion depends on the context. If an object is being
-         --  initialized via an aggregate, then the counter must be inserted
-         --  after the last aggregate assignment.
+         --  place of insertion depends on the context.
 
-         if Ekind_In (Obj_Id, E_Constant, E_Variable)
-           and then Present (Last_Aggregate_Assignment (Obj_Id))
-         then
-            Count_Ins := Last_Aggregate_Assignment (Obj_Id);
-            Body_Ins  := Empty;
+         if Ekind_In (Obj_Id, E_Constant, E_Variable) then
+
+            --  The object is initialized by a build-in-place function call.
+            --  The counter insertion point is after the function call.
+
+            if Present (BIP_Initialization_Call (Obj_Id)) then
+               Count_Ins := BIP_Initialization_Call (Obj_Id);
+               Body_Ins  := Empty;
+
+            --  The object is initialized by an aggregate. Insert the counter
+            --  after the last aggregate assignment.
+
+            elsif Present (Last_Aggregate_Assignment (Obj_Id)) then
+               Count_Ins := Last_Aggregate_Assignment (Obj_Id);
+               Body_Ins  := Empty;
+
+            --  In all other cases the counter is inserted after the last call
+            --  to either [Deep_]Initialize or the type-specific init proc.
+
+            else
+               Find_Last_Init (Count_Ins, Body_Ins);
+            end if;
 
          --  In all other cases the counter is inserted after the last call to
-         --  either [Deep_]Initialize or the type specific init proc.
+         --  either [Deep_]Initialize or the type-specific init proc.
 
          else
             Find_Last_Init (Count_Ins, Body_Ins);
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 77fd7e1..fcd16a2 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -2948,10 +2948,9 @@ package body Exp_Util is
                                           N_Discriminant_Association,
                                           N_Parameter_Association,
                                           N_Pragma_Argument_Association)
-              and then not Nkind_In
-                             (Parent (Par), N_Function_Call,
-                                            N_Procedure_Call_Statement,
-                                            N_Entry_Call_Statement)
+              and then not Nkind_In (Parent (Par), N_Function_Call,
+                                                   N_Procedure_Call_Statement,
+                                                   N_Entry_Call_Statement)
 
             then
                return Par;
@@ -8279,16 +8278,21 @@ package body Exp_Util is
                return False;
 
             --  The object is of the form:
-            --    Obj : Typ [:= Expr];
+            --    Obj : [constant] Typ [:= Expr];
             --
-            --  Do not process the incomplete view of a deferred constant. Do
-            --  not consider tag-to-class-wide conversions.
+            --  Do not process tag-to-class-wide conversions because they do
+            --  not yield an object. Do not process the incomplete view of a
+            --  deferred constant. Note that an object initialized by means
+            --  of a build-in-place function call may appear as a deferred
+            --  constant after expansion activities. These kinds of objects
+            --  must be finalized.
 
             elsif not Is_Imported (Obj_Id)
               and then Needs_Finalization (Obj_Typ)
-              and then not (Ekind (Obj_Id) = E_Constant
-                             and then not Has_Completion (Obj_Id))
               and then not Is_Tag_To_Class_Wide_Conversion (Obj_Id)
+              and then not (Ekind (Obj_Id) = E_Constant
+                             and then not Has_Completion (Obj_Id)
+                             and then No (BIP_Initialization_Call (Obj_Id)))
             then
                return True;
 
diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb
index 172edaf..86ac2b5 100644
--- a/gcc/ada/g-comlin.adb
+++ b/gcc/ada/g-comlin.adb
@@ -3073,6 +3073,7 @@ package body GNAT.Command_Line is
                Free (Config.Switches (S).Long_Switch);
                Free (Config.Switches (S).Help);
                Free (Config.Switches (S).Section);
+               Free (Config.Switches (S).Argument);
             end loop;
 
             Unchecked_Free (Config.Switches);
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index f153517..eefeabe 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -5348,7 +5348,9 @@ package body Sem_Attr is
             if Is_Entity_Name (P) then
                Pref_Id := Entity (P);
 
-               if Ekind_In (Pref_Id, E_Function, E_Generic_Function) then
+               if Ekind_In (Pref_Id, E_Function, E_Generic_Function)
+                 and then Ekind (Spec_Id) = Ekind (Pref_Id)
+               then
                   if Denote_Same_Function (Pref_Id, Spec_Id) then
 
                      --  Correct the prefix of the attribute when the context
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 22b4721..6a72f28 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2165,6 +2165,13 @@ package body Sem_Ch3 is
       --  (They have the sloc of the label as found in the source, and that
       --  is ahead of the current declarative part).
 
+      procedure Check_Entry_Contracts;
+      --  Perform a pre-analysis of the pre- and postconditions of an entry
+      --  declaration. This must be done before full resolution and creation
+      --  of the parameter block, etc. to catch illegal uses within the
+      --  contract expression. Full analysis of the expression is done when
+      --  the contract is processed.
+
       procedure Handle_Late_Controlled_Primitive (Body_Decl : Node_Id);
       --  Determine whether Body_Decl denotes the body of a late controlled
       --  primitive (either Initialize, Adjust or Finalize). If this is the
@@ -2189,6 +2196,56 @@ package body Sem_Ch3 is
          end loop;
       end Adjust_Decl;
 
+      ---------------------------
+      -- Check_Entry_Contracts --
+      ---------------------------
+
+      procedure Check_Entry_Contracts is
+         ASN : Node_Id;
+         Ent : Entity_Id;
+         Exp : Node_Id;
+
+      begin
+         Ent := First_Entity (Current_Scope);
+         while Present (Ent) loop
+
+            --  This only concerns entries with pre/postconditions
+
+            if Ekind (Ent) = E_Entry
+              and then Present (Contract (Ent))
+              and then Present (Pre_Post_Conditions (Contract (Ent)))
+            then
+               ASN := Pre_Post_Conditions (Contract (Ent));
+               Push_Scope (Ent);
+               Install_Formals (Ent);
+
+               --  Pre/postconditions are rewritten as Check pragmas. Analysis
+               --  is performed on a copy of the pragma expression, to prevent
+               --  modifying the original expression.
+
+               while Present (ASN) loop
+                  if Nkind (ASN) = N_Pragma then
+                     Exp :=
+                       New_Copy_Tree
+                         (Expression
+                           (First (Pragma_Argument_Associations (ASN))));
+                     Set_Parent (Exp, ASN);
+
+                     --  ??? why not Preanalyze_Assert_Expression
+
+                     Preanalyze (Exp);
+                  end if;
+
+                  ASN := Next_Pragma (ASN);
+               end loop;
+
+               End_Scope;
+            end if;
+
+            Next_Entity (Ent);
+         end loop;
+      end Check_Entry_Contracts;
+
       --------------------------------------
       -- Handle_Late_Controlled_Primitive --
       --------------------------------------
@@ -2349,12 +2406,14 @@ package body Sem_Ch3 is
          --  (This is needed in any case for early instantiations ???).
 
          if No (Next_Decl) then
-            if Nkind_In (Parent (L), N_Component_List,
-                                     N_Task_Definition,
-                                     N_Protected_Definition)
-            then
+            if Nkind (Parent (L)) = N_Component_List then
                null;
 
+            elsif Nkind_In (Parent (L), N_Protected_Definition,
+                                        N_Task_Definition)
+            then
+               Check_Entry_Contracts;
+
             elsif Nkind (Parent (L)) /= N_Package_Specification then
                if Nkind (Parent (L)) = N_Package_Body then
                   Freeze_From := First_Entity (Current_Scope);