From 3b9d159401751981118415b472dd0bdb68e862f6 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 26 Sep 2018 09:16:49 +0000 Subject: [PATCH] [Ada] Wrong handling of address clause for limited record type 2018-09-26 Eric Botcazou gcc/ada/ * gcc-interface/decl.c (gnat_to_gnu_entity) : Adjust code retrieving the address when a clause has already been processed. * gcc-interface/trans.c (gnat_to_gnu) : 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 | 9 +++++++++ gcc/ada/gcc-interface/decl.c | 8 ++++---- gcc/ada/gcc-interface/trans.c | 32 ++++++++++++++++++++++++------ gcc/testsuite/ChangeLog | 6 ++++++ gcc/testsuite/gnat.dg/addr12.adb | 8 ++++++++ gcc/testsuite/gnat.dg/addr12_a.adb | 20 +++++++++++++++++++ gcc/testsuite/gnat.dg/addr12_a.ads | 3 +++ gcc/testsuite/gnat.dg/addr12_b.adb | 8 ++++++++ gcc/testsuite/gnat.dg/addr12_b.ads | 24 ++++++++++++++++++++++ gcc/testsuite/gnat.dg/addr12_c.ads | 6 ++++++ 10 files changed, 114 insertions(+), 10 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/addr12.adb create mode 100644 gcc/testsuite/gnat.dg/addr12_a.adb create mode 100644 gcc/testsuite/gnat.dg/addr12_a.ads create mode 100644 gcc/testsuite/gnat.dg/addr12_b.adb create mode 100644 gcc/testsuite/gnat.dg/addr12_b.ads create mode 100644 gcc/testsuite/gnat.dg/addr12_c.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f726904317a..b296122fa45 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2018-09-26 Eric Botcazou + + * gcc-interface/decl.c (gnat_to_gnu_entity) : Adjust + code retrieving the address when a clause has already been + processed. + * gcc-interface/trans.c (gnat_to_gnu) + : For an object with a Freeze + node, build a meaningful expression. + 2018-09-26 Arnaud Charlet * 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 6f605bd64ec..c15b0c8ef2e 100644 --- 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 940bf5f3b3f..3e129b60ce1 100644 --- 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 531e2f15f3b..c97b9c509ee 100644 --- 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 + + * 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 * 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 index 00000000000..7143d5054db --- /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 index 00000000000..fac145a80e7 --- /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 index 00000000000..3278b8c5480 --- /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 index 00000000000..b35c44f5baf --- /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 index 00000000000..8b5840001ae --- /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 index 00000000000..957189bbe89 --- /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; -- 2.30.2