In Ada 2012, you can complete an incomplete type with a private type, so you
can have 3 different views for a single type. As the attached testcase shows,
this can lead to an ICE when the completion is a tagged private type because
the full view is elaborated prematurely.
Tested on x86_64-suse-linux, applied on the mainline.
2013-05-26 Eric Botcazou <ebotca...@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity): Do not prematurely
elaborate the full view of a type with a freeze node.
* gcc-interface/trans.c (process_type): Add explicit predicate.
2013-05-26 Eric Botcazou <ebotca...@adacore.com>
* gnat.dg/incomplete3.ad[sb]: New test.
--
Eric Botcazou
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c (revision 199335)
+++ gcc-interface/decl.c (working copy)
@@ -288,7 +288,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
If we are defining the node, we should not have already processed it.
In that case, we will abort below when we try to save a new GCC tree
for this object. We also need to handle the case of getting a dummy
- type when a Full_View exists. */
+ type when a Full_View exists but be careful so as not to trigger its
+ premature elaboration. */
if ((!definition || (is_type && imported_p))
&& present_gnu_tree (gnat_entity))
{
@@ -297,7 +298,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
if (TREE_CODE (gnu_decl) == TYPE_DECL
&& TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))
&& IN (kind, Incomplete_Or_Private_Kind)
- && Present (Full_View (gnat_entity)))
+ && Present (Full_View (gnat_entity))
+ && (present_gnu_tree (Full_View (gnat_entity))
+ || No (Freeze_Node (Full_View (gnat_entity)))))
{
gnu_decl
= gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, 0);
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 199330)
+++ gcc-interface/trans.c (working copy)
@@ -8723,7 +8723,7 @@ process_type (Entity_Id gnat_entity)
if (Present (Freeze_Node (gnat_entity))
|| (IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)
&& Present (Full_View (gnat_entity))
- && Freeze_Node (Full_View (gnat_entity))
+ && Present (Freeze_Node (Full_View (gnat_entity)))
&& !present_gnu_tree (Full_View (gnat_entity))))
{
elaborate_entity (gnat_entity);
-- { dg-do compile }
package body Incomplete3 is
function Get_Tracer (This : access Output_T'Class) return Tracer_T'class is
begin
return Tracer_T'Class (Tracer_T'(Output => This));
end ;
function Get_Output (This : in Tracer_T) return access Output_T'Class is
begin
return This.Output;
end;
end Incomplete3;
package Incomplete3 is
type Output_T;
type Output_T is abstract tagged private;
type Tracer_T is tagged private;
function Get_Tracer (This : access Output_T'Class) return Tracer_T'class;
function Get_Output (This : in Tracer_T) return access Output_T'Class;
private
type Output_T is abstract tagged record
B : Boolean := True;
end record;
type Tracer_T is tagged record
Output : access Output_T'Class := null;
end record;
end Incomplete3;