Commit 35e2a4b8 by Eric Botcazou Committed by Eric Botcazou

decl.c (gnat_to_gnu_entity): Create variables for size expressions of variant…

decl.c (gnat_to_gnu_entity): Create variables for size expressions of variant part of record types declared...

	* gcc-interface/decl.c (gnat_to_gnu_entity): Create variables for size
	expressions of variant part of record types declared at library level.

From-SVN: r159182
parent da01bfee
2010-05-08 Eric Botcazou <ebotcazou@adacore.com> 2010-05-08 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity): Create variables for size
expressions of variant part of record types declared at library level.
2010-05-08 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (create_field_decl): Move PACKED parameter. * gcc-interface/gigi.h (create_field_decl): Move PACKED parameter.
* gcc-interface/utils.c (create_field_decl): Move PACKED parameter. * gcc-interface/utils.c (create_field_decl): Move PACKED parameter.
(rest_of_record_type_compilation): Adjust call to create_field_decl. (rest_of_record_type_compilation): Adjust call to create_field_decl.
......
...@@ -4516,8 +4516,62 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) ...@@ -4516,8 +4516,62 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (TREE_CODE (gnu_type) == RECORD_TYPE) if (TREE_CODE (gnu_type) == RECORD_TYPE)
{ {
tree variant_part = get_variant_part (gnu_type);
tree ada_size = TYPE_ADA_SIZE (gnu_type); tree ada_size = TYPE_ADA_SIZE (gnu_type);
if (variant_part)
{
tree union_type = TREE_TYPE (variant_part);
tree offset = DECL_FIELD_OFFSET (variant_part);
/* If the position of the variant part is constant, subtract
it from the size of the type of the parent to get the new
size. This manual CSE reduces the data size. */
if (TREE_CODE (offset) == INTEGER_CST)
{
tree bitpos = DECL_FIELD_BIT_OFFSET (variant_part);
TYPE_SIZE (union_type)
= size_binop (MINUS_EXPR, TYPE_SIZE (gnu_type),
bit_from_pos (offset, bitpos));
TYPE_SIZE_UNIT (union_type)
= size_binop (MINUS_EXPR, TYPE_SIZE_UNIT (gnu_type),
byte_from_pos (offset, bitpos));
}
else
{
TYPE_SIZE (union_type)
= elaborate_expression_1 (TYPE_SIZE (union_type),
gnat_entity,
get_identifier ("VSIZE"),
definition, false);
/* ??? For now, store the size as a multiple of the
alignment in bytes so that we can see the alignment
from the tree. */
TYPE_SIZE_UNIT (union_type)
= elaborate_expression_2 (TYPE_SIZE_UNIT (union_type),
gnat_entity,
get_identifier
("VSIZE_A_UNIT"),
definition, false,
TYPE_ALIGN (union_type));
/* ??? For now, store the offset as a multiple of the
alignment in bytes so that we can see the alignment
from the tree. */
DECL_FIELD_OFFSET (variant_part)
= elaborate_expression_2 (offset,
gnat_entity,
get_identifier ("VOFFSET"),
definition, false,
DECL_OFFSET_ALIGN
(variant_part));
}
DECL_SIZE (variant_part) = TYPE_SIZE (union_type);
DECL_SIZE_UNIT (variant_part) = TYPE_SIZE_UNIT (union_type);
}
if (operand_equal_p (ada_size, size, 0)) if (operand_equal_p (ada_size, size, 0))
ada_size = TYPE_SIZE (gnu_type); ada_size = TYPE_SIZE (gnu_type);
else else
......
2010-05-08 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/specs/lto3.ads: New test.
* gnat.dg/specs/lto3_pkg1.ad[sb]: New helper.
* gnat.dg/specs/lto3_pkg2.ad[sb]: Likewise.
2010-05-08 Quentin Ochem <ochem@adacore.com> 2010-05-08 Quentin Ochem <ochem@adacore.com>
* gnat.dg/sizetype3.ad[sb]: New test. * gnat.dg/sizetype3.ad[sb]: New test.
......
-- { dg-do compile }
-- { dg-options "-gnatws -flto" }
with Lto3_Pkg1;
package Lto3 is
package P is new Lto3_Pkg1 (Id_T => Natural);
end Lto3;
package body Lto3_Pkg1 is
function Is_Fixed return Boolean is
begin
return True;
end Is_Fixed;
function Do_Item (I : Natural) return Variable_Data_Fixed_T is
It : Variable_Data_Fixed_T;
begin
return It;
end Do_Item;
My_Db : Db.T;
procedure Run is
Kitem : Variable_Data_Fixed_T;
I : Natural;
begin
Kitem := Db.Get (My_Db);
Kitem := Do_Item (I);
end Run;
end Lto3_Pkg1;
-- { dg-excess-errors "no code generated" }
with Lto3_Pkg2;
generic
type Id_T is range <>;
package Lto3_Pkg1 is
type Variable_Data_T (Fixed : Boolean := False) is
record
case Fixed is
when True =>
Length : Natural;
when False =>
null;
end case;
end record;
function Is_Fixed return Boolean;
type Variable_Data_Fixed_T is new Variable_Data_T (Is_Fixed);
package Db is new Lto3_Pkg2 (Id_T => Id_T,
Data_T => Variable_Data_Fixed_T);
end Lto3_Pkg1;
package body Lto3_Pkg2 is
function Get (X : T) return Data_T is
Result : Data_T;
begin
return Result;
end;
end Lto3_Pkg2;
-- { dg-excess-errors "no code generated" }
generic
type Id_T is private;
type Data_T is private;
package Lto3_Pkg2 is
type T is private;
function Get (X : T) return Data_T;
private
type T is null record;
end Lto3_Pkg2;
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