[multiple changes]

2017-09-08  Javier Miranda  <miranda@adacore.com>

	* exp_ch6.ads (Make_Build_In_Place_Iface_Call_In_Allocator): New
	subprogram.
	(Make_Build_In_Place_Iface_Call_In_Anonymous_Context): New subprogram.
	(Make_Build_In_Place_Iface_Call_In_Object_Declaration): New
	subprogram.
	(Unqual_BIP_Iface_Function_Call): New subprogram.
	* exp_ch6.adb (Replace_Renaming_Declaration_Id): New
	subprogram containing code that was previously inside
	Make_Build_In_Place_Call_In_Object_Declaration since it is also
	required for one of the new subprograms.
	(Expand_Actuals):
	Invoke Make_Build_In_Place_Iface_Call_In_Anonymous_Context
	(Expand_N_Extended_Return_Statement): Extend the
	cases covered by an assertion on expected BIP object
	declarations.
	(Make_Build_In_Place_Call_In_Assignment):
	Removing unused code; found working on this ticket.
	(Make_Build_In_Place_Call_In_Object_Declaration): Move the code
	that replaces the internal name of the renaming declaration
	into the new subprogram Replace_Renaming_Declaration_Id.
	(Make_Build_In_Place_Iface_Call_In_Allocator): New subprogram.
	(Make_Build_In_Place_Iface_Call_In_Anonymous_Context):
	New subprogram.
	(Make_Build_In_Place_Iface_Call_In_Object_Declaration): New
	subprogram.
	(Unqual_BIP_Iface_Function_Call): New subprogram.
	* exp_ch3.adb (Expand_N_Object_Declaration): Invoke the new
	subprogram Make_Build_In_Place_Iface_Call_In_Object_Declaration.
	* exp_attr.adb (Expand_N_Attribute_Reference): Invoke the new
	subprogram Make_Build_In_Place_Iface_Call_In_Anonymous_Context.
	* exp_ch4.adb (Expand_Allocator_Expression): Invoke the new
	subprogram Make_Build_In_Place_Iface_Call_In_Allocator.
	(Expand_N_Indexed_Component): Invoke the new subprogram
	Make_Build_In_Place_Iface_Call_In_Anonymous_Context.
	(Expand_N_Selected_Component): Invoke the new subprogram
	Make_Build_In_Place_Iface_Call_In_Anonymous_Context.
	(Expand_N_Slice): Invoke the new subprogram
	Make_Build_In_Place_Iface_Call_In_Anonymous_Context.
	* exp_ch8.adb (Expand_N_Object_Renaming_Declaration):
	Invoke the new subprogram
	Make_Build_In_Place_Iface_Call_In_Anonymous_Context.

2017-09-08  Javier Miranda  <miranda@adacore.com>

	* exp_disp.adb (Expand_Interface_Conversion): Fix handling of
	access to interface types.  Remove also the accessibility check.

2017-09-08  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch6.adb (Freeze_Expr_Types): Really freeze
	all the types that are referenced by the expression.
	(Analyze_Expression_Function): Call Freeze_Expr_Types for
	a completion instead of manually freezing the type of the
	expression.
	(Analyze_Subprogram_Body_Helper): Do not call Freeze_Expr_Types here.

2017-09-08  Ed Schonberg  <schonberg@adacore.com>

	* exp_prag.adb (Replace_Discriminals_Of_Protected_Op):
	New procedure, auxiliary to Expand_Pragma_Check, to handle
	references to the discriminants of a protected type within a
	precondition of a protected operation. This is needed because
	the original precondition has been analyzed in the context of
	the protected declaration, but in the body of the operation
	references to the discriminants have been replaved by references
	to the discriminants of the target object, and these references
	are only created when expanding the protected body.

From-SVN: r251879

1 files changed, 88 insertions, 0 deletions

diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 7ed1136..c60f75a 100644
--- a/gcc/ada/exp_prag.adb
+++ b/gcc/ada/exp_prag.adb
@@ -320,6 +320,84 @@ package body Exp_Prag is
       --  Assert_Failure, so that coverage analysis tools can relate the
       --  call to the failed check.
 
+      procedure Replace_Discriminals_Of_Protected_Op (Expr : Node_Id);
+      --  Discriminants of the enclosing protected object may be referenced
+      --  in the expression of a precondition of a protected operation.
+      --  In the body of the operation these references must be replaced by
+      --  the discriminal created for them, which area renamings of the
+      --  discriminants of the object that is the target of the operation.
+      --  This replacement is done by visibility when the references appear
+      --  in the subprogram body, but in the case of a condition which appears
+      --  on the specification of the subprogram it has be done separately
+      --  because the condition has been replaced by a Check pragma and
+      --  analyzed earlier, before the creation of the discriminal renaming
+      --  declarations that are added to the subprogram body.
+
+      ------------------------------------------
+      -- Replace_Discriminals_Of_Protected_Op --
+      ------------------------------------------
+
+      procedure Replace_Discriminals_Of_Protected_Op (Expr : Node_Id) is
+         function Find_Corresponding_Discriminal (E : Entity_Id)
+           return Entity_Id;
+         --  Find the local entity that renames a discriminant of the
+         --  enclosing protected type, and has a matching name.
+
+         ------------------------------------
+         -- find_Corresponding_Discriminal --
+         ------------------------------------
+
+         function Find_Corresponding_Discriminal (E : Entity_Id)
+           return Entity_Id
+         is
+            R : Entity_Id;
+
+         begin
+            R := First_Entity (Current_Scope);
+
+            while Present (R) loop
+               if Nkind (Parent (R)) = N_Object_Renaming_Declaration
+                 and then Present (Discriminal_Link (R))
+                 and then Chars (Discriminal_Link (R)) = Chars (E)
+               then
+                  return R;
+               end if;
+
+               Next_Entity (R);
+            end loop;
+
+            return Empty;
+         end Find_Corresponding_Discriminal;
+
+         function  Replace_Discr_Ref (N : Node_Id) return Traverse_Result;
+         --  Replace a reference to a discriminant of the original protected
+         --  type by the local renaming declaration of the discriminant of
+         --  the target object.
+
+         -----------------------
+         -- Replace_Discr_Ref --
+         -----------------------
+
+         function  Replace_Discr_Ref (N : Node_Id) return Traverse_Result is
+            R : Entity_Id;
+
+         begin
+            if Is_Entity_Name (N)
+               and then Present (Discriminal_Link (Entity (N)))
+            then
+               R := Find_Corresponding_Discriminal (Entity (N));
+               Rewrite (N, New_Occurrence_Of (R, Sloc (N)));
+            end if;
+            return OK;
+         end Replace_Discr_Ref;
+
+         procedure Replace_Discriminant_References is
+           new Traverse_Proc (Replace_Discr_Ref);
+
+      begin
+         Replace_Discriminant_References (Expr);
+      end Replace_Discriminals_Of_Protected_Op;
+
    begin
       --  Nothing to do if pragma is ignored
 
@@ -456,6 +534,16 @@ package body Exp_Prag is
             end;
          end if;
 
+         --  For a precondition, replace references to discriminants of a
+         --  protected type with the local discriminals.
+
+         if Is_Protected_Type (Scope (Current_Scope))
+           and then Has_Discriminants (Scope (Current_Scope))
+           and then From_Aspect_Specification (N)
+         then
+            Replace_Discriminals_Of_Protected_Op (Cond);
+         end if;
+
          --  Now rewrite as an if statement
 
          Rewrite (N,