Commit 3fd7a66f by Eric Botcazou Committed by Eric Botcazou

decl.c (gnat_to_gnu_entity): Do not prematurely elaborate the full view of a…

decl.c (gnat_to_gnu_entity): Do not prematurely elaborate the full view of a type with a freeze node.

	* 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.

From-SVN: r199336
parent 184179f1
2013-05-26 Eric Botcazou <ebotcazou@adacore.com> 2013-05-26 Eric Botcazou <ebotcazou@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 <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Always build the * gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Always build the
UNC variable for aliased objects with unconstrained nominal subtype. UNC variable for aliased objects with unconstrained nominal subtype.
......
...@@ -288,7 +288,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -288,7 +288,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
If we are defining the node, we should not have already processed it. 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 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 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)) if ((!definition || (is_type && imported_p))
&& present_gnu_tree (gnat_entity)) && present_gnu_tree (gnat_entity))
{ {
...@@ -297,7 +298,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -297,7 +298,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (TREE_CODE (gnu_decl) == TYPE_DECL if (TREE_CODE (gnu_decl) == TYPE_DECL
&& TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl)) && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))
&& IN (kind, Incomplete_Or_Private_Kind) && 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 gnu_decl
= gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, 0); = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, 0);
......
...@@ -8723,7 +8723,7 @@ process_type (Entity_Id gnat_entity) ...@@ -8723,7 +8723,7 @@ process_type (Entity_Id gnat_entity)
if (Present (Freeze_Node (gnat_entity)) if (Present (Freeze_Node (gnat_entity))
|| (IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind) || (IN (Ekind (gnat_entity), Incomplete_Or_Private_Kind)
&& Present (Full_View (gnat_entity)) && 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)))) && !present_gnu_tree (Full_View (gnat_entity))))
{ {
elaborate_entity (gnat_entity); elaborate_entity (gnat_entity);
......
2013-05-26 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/incomplete3.ad[sb]: New test.
2013-05-25 Richard Sandiford <rdsandiford@googlemail.com> 2013-05-25 Richard Sandiford <rdsandiford@googlemail.com>
PR target/53916 PR target/53916
......
-- { 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment