[Ada] Wrong handling of address clause for limited record type

2018-09-26  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Adjust
	code retrieving the address when a clause has already been
	processed.
	* gcc-interface/trans.c (gnat_to_gnu)
	<N_Attribute_Definition_Clause>: For an object with a Freeze
	node, build a meaningful expression.

gcc/testsuite/

	* gnat.dg/addr12.adb, gnat.dg/addr12_a.adb,
	gnat.dg/addr12_a.ads, gnat.dg/addr12_b.adb,
	gnat.dg/addr12_b.ads, gnat.dg/addr12_c.ads: New testcase.

From-SVN: r264606

gcc/ada/ChangeLog

+2018-09-26  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Adjust
+	code retrieving the address when a clause has already been
+	processed.
+	* gcc-interface/trans.c (gnat_to_gnu)
+	<N_Attribute_Definition_Clause>: For an object with a Freeze
+	node, build a meaningful expression.
+
 2018-09-26  Arnaud Charlet  <charlet@adacore.com>
 
 	* gnat1drv.adb (Adjust_Global_Switches): -gnatd_A sets

gcc/ada/gcc-interface/decl.c

@@ -1147,10 +1147,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	if (definition && Present (Address_Clause (gnat_entity)))
 	  {
 	    const Node_Id gnat_clause = Address_Clause (gnat_entity);
-	    Node_Id gnat_address = Expression (gnat_clause);
-	    tree gnu_address
-	      = present_gnu_tree (gnat_entity)
-		? get_gnu_tree (gnat_entity) : gnat_to_gnu (gnat_address);
+	    const Node_Id gnat_address = Expression (gnat_clause);
+	    tree gnu_address = present_gnu_tree (gnat_entity)
+			       ? TREE_OPERAND (get_gnu_tree (gnat_entity), 0)
+			       : gnat_to_gnu (gnat_address);
 
 	    save_gnu_tree (gnat_entity, NULL_TREE, false);
 

gcc/ada/gcc-interface/trans.c

@@ -7570,13 +7570,33 @@ gnat_to_gnu (Node_Id gnat_node)
 
       /* And we only deal with 'Address if the object has a Freeze node.  */
       gnat_temp = Entity (Name (gnat_node));
-      if (No (Freeze_Node (gnat_temp)))
-	break;
+      if (Freeze_Node (gnat_temp))
+	{
+	  tree gnu_address = gnat_to_gnu (Expression (gnat_node));
+
+	  /* Get the value to use as the address and save it as the equivalent
+	     for the object; when it is frozen, gnat_to_gnu_entity will do the
+	     right thing.  For a subprogram, put the naked address but build a
+	     meaningfull expression for an object in case its address is taken
+	     before the Freeze node is encountered; this can happen if the type
+	     of the object is limited and it is initialized with the result of
+	     a function call.  */
+	  if (Is_Subprogram (gnat_temp))
+	    gnu_result = gnu_address;
+	  else
+	    {
+	      tree gnu_type = gnat_to_gnu_type (Etype (gnat_temp));
+	      /* Drop atomic and volatile qualifiers for the expression.  */
+	      gnu_type = TYPE_MAIN_VARIANT (gnu_type);
+	      gnu_type
+		= build_reference_type_for_mode (gnu_type, ptr_mode, true);
+	      gnu_address = convert (gnu_type, gnu_address);
+	      gnu_result
+		= build_unary_op (INDIRECT_REF, NULL_TREE, gnu_address);
+	    }
 
-      /* Get the value to use as the address and save it as the equivalent
-	 for the object.  When it is frozen, gnat_to_gnu_entity will do the
-	 right thing.  */
-      save_gnu_tree (gnat_temp, gnat_to_gnu (Expression (gnat_node)), true);
+	  save_gnu_tree (gnat_temp, gnu_result, true);
+	}
       break;
 
     case N_Enumeration_Representation_Clause:

gcc/testsuite/ChangeLog

@@ -5,6 +5,12 @@
 
 2018-09-26  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gnat.dg/addr12.adb, gnat.dg/addr12_a.adb,
+	gnat.dg/addr12_a.ads, gnat.dg/addr12_b.adb,
+	gnat.dg/addr12_b.ads, gnat.dg/addr12_c.ads: New testcase.
+
+2018-09-26  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* g++.dg/other/vthunk1.C: Rename to...
 	* g++.dg/other/thunk1.C: ...this.
 	* g++.dg/other/thunk2a.C: New test.

gcc/testsuite/gnat.dg/addr12.adb

+--  { dg-do run }
+
+with Addr12_A;
+
+procedure Addr12 is
+begin
+   Addr12_A.Do_Stuff;
+end;

gcc/testsuite/gnat.dg/addr12_a.adb

+with Addr12_B;
+with Addr12_C;
+with System;
+
+package body Addr12_A is
+
+   First_Address  : constant System.Address := Addr12_C.First'Address;
+   Second_Address : constant System.Address := Addr12_C.Second'Address;
+
+   First_Channel : Addr12_B.Shared_Context_Type := Addr12_B.Initial_State
+   with Volatile, Async_Readers, Address => First_Address;
+
+   Second_Channel : Addr12_B.Shared_Context_Type := Addr12_B.Initial_State
+   with Volatile, Async_Readers;
+
+   for Second_Channel'Address use Second_Address;
+
+   procedure Do_Stuff is null;
+
+end Addr12_A;

gcc/testsuite/gnat.dg/addr12_a.ads

+package Addr12_A is
+   procedure Do_Stuff;
+end Addr12_A;

gcc/testsuite/gnat.dg/addr12_b.adb

+package body Addr12_B is
+
+   function Initial_State return Shared_Context_Type is
+   begin
+      return Shared_Context_Type'(Data => (others => Null_Entry));
+   end Initial_State;
+
+end Addr12_B;

gcc/testsuite/gnat.dg/addr12_b.ads

+package Addr12_B is
+
+   type Entry_Type is record
+      Auto_Init : Boolean;
+   end record;
+
+   type Entry_Range  is range 1 .. 20;
+   type Entries_Type is array (Entry_Range) of Entry_Type;
+
+   Null_Entry : constant Entry_Type := Entry_Type'(Auto_Init => False);
+
+   type Shared_Context_Type is limited private;
+
+   function Initial_State return Shared_Context_Type
+   with Volatile_Function;
+
+private
+
+   type Shared_Context_Type is limited record
+      Data : Entries_Type;
+   end record
+   with Volatile;
+
+end Addr12_B;

gcc/testsuite/gnat.dg/addr12_c.ads

+with Addr12_B;
+
+package Addr12_C is
+   First : Addr12_B.Shared_Context_Type;
+   Second : Addr12_B.Shared_Context_Type;
+end Addr12_C;