[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f726904317ab69e4fbca458a2fa967444f2ea4c2..b296122fa45de1df2c262ed79aef567ae2394627 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+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

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 6f605bd64ecdedd1b6edad8436dd5ffefed30eb4..c15b0c8ef2e9280408e1de9d88d9788cd9675eee 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/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);
 

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 940bf5f3b3f78cd3fe1ded9bf3ffdb121161b1e5..3e129b60ce1327484f8d1882e0f98d93eecc858d 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/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:

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 531e2f15f3b00a902c70e13c5cf0da0c77305755..c97b9c509ee8e1f339ac05a6855cd7f6fc70180d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -3,6 +3,12 @@
        PR c++/67656
        * g++.dg/concepts/pr67656.C: New.
 
+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...

diff --git a/gcc/testsuite/gnat.dg/addr12.adb b/gcc/testsuite/gnat.dg/addr12.adb
new file mode 100644 (file)
index 0000000..7143d50
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/addr12.adb
@@ -0,0 +1,8 @@
+--  { dg-do run }
+
+with Addr12_A;
+
+procedure Addr12 is
+begin
+   Addr12_A.Do_Stuff;
+end;

diff --git a/gcc/testsuite/gnat.dg/addr12_a.adb b/gcc/testsuite/gnat.dg/addr12_a.adb
new file mode 100644 (file)
index 0000000..fac145a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/addr12_a.adb
@@ -0,0 +1,20 @@
+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;

diff --git a/gcc/testsuite/gnat.dg/addr12_a.ads b/gcc/testsuite/gnat.dg/addr12_a.ads
new file mode 100644 (file)
index 0000000..3278b8c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/addr12_a.ads
@@ -0,0 +1,3 @@
+package Addr12_A is
+   procedure Do_Stuff;
+end Addr12_A;

diff --git a/gcc/testsuite/gnat.dg/addr12_b.adb b/gcc/testsuite/gnat.dg/addr12_b.adb
new file mode 100644 (file)
index 0000000..b35c44f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/addr12_b.adb
@@ -0,0 +1,8 @@
+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;

diff --git a/gcc/testsuite/gnat.dg/addr12_b.ads b/gcc/testsuite/gnat.dg/addr12_b.ads
new file mode 100644 (file)
index 0000000..8b58400
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/addr12_b.ads
@@ -0,0 +1,24 @@
+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;

diff --git a/gcc/testsuite/gnat.dg/addr12_c.ads b/gcc/testsuite/gnat.dg/addr12_c.ads
new file mode 100644 (file)
index 0000000..957189b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/addr12_c.ads
@@ -0,0 +1,6 @@
+with Addr12_B;
+
+package Addr12_C is
+   First : Addr12_B.Shared_Context_Type;
+   Second : Addr12_B.Shared_Context_Type;
+end Addr12_C;