trans.c (add_decl_expr): At toplevel, mark the TYPE_ADA_SIZE field of records and unions.

* gcc-interface/trans.c (add_decl_expr): At toplevel, mark the
	TYPE_ADA_SIZE field of records and unions.

	* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Length>: Set the
	source location of the node onto the comparison expression if it
	is not cached.

From-SVN: r154978
This commit is contained in:
Eric Botcazou 2009-12-04 12:05:08 +00:00 committed by Eric Botcazou
parent a7004a7e0e
commit 321e10dd4c
8 changed files with 100 additions and 1 deletions

View File

@ -1,3 +1,12 @@
2009-12-04 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (add_decl_expr): At toplevel, mark the
TYPE_ADA_SIZE field of records and unions.
* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Length>: Set the
source location of the node onto the comparison expression if it
is not cached.
2009-12-03 Eric Botcazou <ebotcazou@adacore.com>
* exp_util.adb (Make_CW_Equivalent_Type): Set the

View File

@ -1624,6 +1624,16 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
else
pa->length = gnu_result;
}
/* Set the source location onto the predicate of the condition in the
'Length case but do not do it if the expression is cached to avoid
messing up the debug info. */
else if ((attribute == Attr_Range_Length || attribute == Attr_Length)
&& TREE_CODE (gnu_result) == COND_EXPR
&& EXPR_P (TREE_OPERAND (gnu_result, 0)))
set_expr_location_from_node (TREE_OPERAND (gnu_result, 0),
gnat_node);
break;
}
@ -5578,7 +5588,6 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
Note that walk_tree knows how to deal with TYPE_DECL, but neither
VAR_DECL nor CONST_DECL. This appears to be somewhat arbitrary. */
MARK_VISITED (gnu_stmt);
if (TREE_CODE (gnu_decl) == VAR_DECL
|| TREE_CODE (gnu_decl) == CONST_DECL)
{
@ -5586,6 +5595,13 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
MARK_VISITED (DECL_SIZE_UNIT (gnu_decl));
MARK_VISITED (DECL_INITIAL (gnu_decl));
}
/* In any case, we have to deal with our own TYPE_ADA_SIZE field. */
else if (TREE_CODE (gnu_decl) == TYPE_DECL
&& ((TREE_CODE (type) == RECORD_TYPE
&& !TYPE_FAT_POINTER_P (type))
|| TREE_CODE (type) == UNION_TYPE
|| TREE_CODE (type) == QUAL_UNION_TYPE))
MARK_VISITED (TYPE_ADA_SIZE (type));
}
else
add_stmt_with_node (gnu_stmt, gnat_entity);

View File

@ -1,3 +1,9 @@
2009-12-04 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/specs/size_attribute1.ads: New test.
* gnat.dg/specs/size_attribute1_pkg1.ad[sb]: New helper.
* gnat.dg/specs/size_attribute1_pkg2.ad[sb]: Likewise.
2009-12-04 Dodji Seketeli <dodji@redhat.com>
PR c++/42218

View File

@ -0,0 +1,20 @@
-- { dg-do compile }
with Size_Attribute1_Pkg1;
package Size_Attribute1 is
function Num return Natural;
pragma Import (Ada, Num);
type A is array (Natural range <>) of Integer;
type T is
record
F1 : Long_Float;
F2 : A (1 .. Num);
end record;
package My_Q is new Size_Attribute1_Pkg1 (T);
end Size_Attribute1;

View File

@ -0,0 +1,13 @@
package body Size_Attribute1_Pkg1 is
type Rec is
record
F : T;
end record;
procedure Dummy is
begin
null;
end;
end Size_Attribute1_Pkg1;

View File

@ -0,0 +1,15 @@
-- { dg-excess-errors "no code generated" }
with Size_Attribute1_Pkg2;
generic
type T is private;
package Size_Attribute1_Pkg1 is
package My_R is new Size_Attribute1_Pkg2 (T);
procedure Dummy;
end Size_Attribute1_Pkg1;

View File

@ -0,0 +1,9 @@
package body Size_Attribute1_Pkg2 is
procedure Proc is
I : Integer := T'Size;
begin
null;
end;
end Size_Attribute1_Pkg2;

View File

@ -0,0 +1,11 @@
-- { dg-excess-errors "no code generated" }
generic
type T is private;
package Size_Attribute1_Pkg2 is
procedure Proc;
end Size_Attribute1_Pkg2;