procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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
This commit is contained in:
Eric Botcazou 2008-06-12 13:19:06 +00:00 • committed by Eric Botcazou
parent fcd2a5d4d6
commit 1dd4a3e637
5 changed files with 96 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/ada/ChangeLog
View file

@ -1,3 +1,9 @@
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

98
gcc/ada/decl.c
View file

@ -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);
gnu_field_list = nreverse (gnu_field_list);
finish_record_type (gnu_type, 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)));
/* 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. */

4
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,7 @@
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):

10
gcc/testsuite/gnat.dg/discr9.adb Normal file
View file

@ -0,0 +1,10 @@
-- { 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;

22
gcc/testsuite/gnat.dg/discr9.ads Normal file
View file

@ -0,0 +1,22 @@
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;