Commit 1dd4a3e6 by Eric Botcazou Committed by Eric Botcazou

decl.c (gnat_to_gnu_entity): In the case of a constrained subtype of a discriminated type...

	* decl.c (gnat_to_gnu_entity) <E_Record_Subtype>: In the case of a
	constrained subtype of a discriminated type, discard the fields that
	are beyond its limits according to its size.

From-SVN: r136707
parent fcd2a5d4
2008-06-12 Eric Botcazou <ebotcazou@adacore.com>
* decl.c (gnat_to_gnu_entity) <E_Record_Subtype>: In the case of a
constrained subtype of a discriminated type, discard the fields that
are beyond its limits according to its size.
2008-06-10 Olivier Hainque <hainque@adacore.com>
* utils.c (create_subprog_decl): If this is for the 'main' entry
......@@ -2922,9 +2922,42 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_type = make_node (RECORD_TYPE);
TYPE_NAME (gnu_type) = gnu_entity_id;
TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_base_type);
TYPE_VOLATILE (gnu_type) = Treat_As_Volatile (gnat_entity);
/* Set the size, alignment and alias set of the new type to
match that of the old one, doing required substitutions.
We do it this early because we need the size of the new
type below to discard old fields if necessary. */
TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_base_type);
TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_base_type);
SET_TYPE_ADA_SIZE (gnu_type, TYPE_ADA_SIZE (gnu_base_type));
TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_base_type);
copy_alias_set (gnu_type, gnu_base_type);
if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
for (gnu_temp = gnu_subst_list;
gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
TYPE_SIZE (gnu_type)
= substitute_in_expr (TYPE_SIZE (gnu_type),
TREE_PURPOSE (gnu_temp),
TREE_VALUE (gnu_temp));
if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE_UNIT (gnu_type)))
for (gnu_temp = gnu_subst_list;
gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
TYPE_SIZE_UNIT (gnu_type)
= substitute_in_expr (TYPE_SIZE_UNIT (gnu_type),
TREE_PURPOSE (gnu_temp),
TREE_VALUE (gnu_temp));
if (CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (gnu_type)))
for (gnu_temp = gnu_subst_list;
gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
SET_TYPE_ADA_SIZE
(gnu_type, substitute_in_expr (TYPE_ADA_SIZE (gnu_type),
TREE_PURPOSE (gnu_temp),
TREE_VALUE (gnu_temp)));
for (gnat_field = First_Entity (gnat_entity);
Present (gnat_field); gnat_field = Next_Entity (gnat_field))
if ((Ekind (gnat_field) == E_Component
......@@ -2946,7 +2979,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
tree gnu_field_type
= gnat_to_gnu_type (Etype (gnat_field));
tree gnu_size = TYPE_SIZE (gnu_field_type);
tree gnu_new_pos = 0;
tree gnu_new_pos = NULL_TREE;
unsigned int offset_align
= tree_low_cst (TREE_PURPOSE (TREE_VALUE (gnu_offset)),
1);
......@@ -2992,11 +3025,23 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TREE_PURPOSE (gnu_temp),
TREE_VALUE (gnu_temp));
/* If the size is now a constant, we can set it as the
size of the field when we make it. Otherwise, we need
to deal with it specially. */
/* If the position is now a constant, we can set it as the
position of the field when we make it. Otherwise, we need
to deal with it specially below. */
if (TREE_CONSTANT (gnu_pos))
gnu_new_pos = bit_from_pos (gnu_pos, gnu_bitpos);
{
gnu_new_pos = bit_from_pos (gnu_pos, gnu_bitpos);
/* Discard old fields that are outside the new type.
This avoids confusing code scanning it to decide
how to pass it to functions on some platforms. */
if (TREE_CODE (gnu_new_pos) == INTEGER_CST
&& TREE_CODE (TYPE_SIZE (gnu_type)) == INTEGER_CST
&& !integer_zerop (gnu_size)
&& !tree_int_cst_lt (gnu_new_pos,
TYPE_SIZE (gnu_type)))
continue;
}
gnu_field
= create_field_decl
......@@ -3044,49 +3089,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnat_to_gnu_entity (Etype (gnat_field), NULL_TREE, 0);
/* Do not finalize it since we're going to modify it below. */
finish_record_type (gnu_type, nreverse (gnu_field_list),
2, true);
/* Now set the size, alignment and alias set of the new type to
match that of the old one, doing any substitutions, as
above. */
TYPE_ALIGN (gnu_type) = TYPE_ALIGN (gnu_base_type);
TYPE_SIZE (gnu_type) = TYPE_SIZE (gnu_base_type);
TYPE_SIZE_UNIT (gnu_type) = TYPE_SIZE_UNIT (gnu_base_type);
SET_TYPE_ADA_SIZE (gnu_type, TYPE_ADA_SIZE (gnu_base_type));
copy_alias_set (gnu_type, gnu_base_type);
if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type)))
for (gnu_temp = gnu_subst_list;
gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
TYPE_SIZE (gnu_type)
= substitute_in_expr (TYPE_SIZE (gnu_type),
TREE_PURPOSE (gnu_temp),
TREE_VALUE (gnu_temp));
if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE_UNIT (gnu_type)))
for (gnu_temp = gnu_subst_list;
gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
TYPE_SIZE_UNIT (gnu_type)
= substitute_in_expr (TYPE_SIZE_UNIT (gnu_type),
TREE_PURPOSE (gnu_temp),
TREE_VALUE (gnu_temp));
if (CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (gnu_type)))
for (gnu_temp = gnu_subst_list;
gnu_temp; gnu_temp = TREE_CHAIN (gnu_temp))
SET_TYPE_ADA_SIZE
(gnu_type, substitute_in_expr (TYPE_ADA_SIZE (gnu_type),
TREE_PURPOSE (gnu_temp),
TREE_VALUE (gnu_temp)));
gnu_field_list = nreverse (gnu_field_list);
finish_record_type (gnu_type, gnu_field_list, 2, true);
/* Reapply variable_size since we have changed the sizes. */
/* Finalize size and mode. */
TYPE_SIZE (gnu_type) = variable_size (TYPE_SIZE (gnu_type));
TYPE_SIZE_UNIT (gnu_type)
= variable_size (TYPE_SIZE_UNIT (gnu_type));
/* Recompute the mode of this record type now that we know its
actual size. */
compute_record_mode (gnu_type);
/* Fill in locations of fields. */
......
2008-06-12 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/discr9.ad[sb]: New test.
2008-06-12 Joseph Myers <joseph@codesourcery.com>
* gcc.dg/compat/struct-layout-1.exp (orig_gcc_exec_prefix_saved):
......
-- { dg-do compile }
package body Discr9 is
procedure Proc (From : in R; To : out R) is
begin
To := R'(D1 => False, D2 => From.D2, Field => From.Field);
end;
end Discr9;
package Discr9 is
type IArr is Array (Natural range <>) of Integer;
type CArr is Array (Natural range <>) of Character;
type Var_R (D1 : Boolean; D2 : Boolean) is record
case D1 is
when True =>
L : IArr (1..4);
M1, M2 : CArr (1..16);
when False =>
null;
end case;
end record;
type R (D1 : Boolean; D2 : Boolean) is record
Field : Var_R (D1, D2);
end record;
procedure Proc (From : in R; To : out R);
end Discr9;
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