decl.c (gnat_to_gnu_entity): Constify a handful of local variables.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: Constify a handful of local variables. For a derived untagged type that renames discriminants, change the type of the stored discriminants to a subtype with the bounds of the type of the visible discriminants. (build_subst_list): Rename local variable. From-SVN: r199279
This commit is contained in:
Eric Botcazou
Eric Botcazou
parent
b17c024fa9
commit
908ba941c3
4 changed files with 89 additions and 13 deletions
|
|
@ -1,3 +1,12 @@
|
|||
2013-05-24 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: Constify
|
||||
a handful of local variables.
|
||||
For a derived untagged type that renames discriminants, change the type
|
||||
of the stored discriminants to a subtype with the bounds of the type
|
||||
of the visible discriminants.
|
||||
(build_subst_list): Rename local variable.
|
||||
|
||||
2013-05-16 Jason Merrill <jason@redhat.com>
|
||||
|
||||
* gcc-interface/Make-lang.in (gnat1$(exeext)): Use link mutex.
|
||||
|
|
|
|||
|
|
@ -2913,10 +2913,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
{
|
||||
Node_Id full_definition = Declaration_Node (gnat_entity);
|
||||
Node_Id record_definition = Type_Definition (full_definition);
|
||||
Node_Id gnat_constr;
|
||||
Entity_Id gnat_field;
|
||||
tree gnu_field, gnu_field_list = NULL_TREE, gnu_get_parent;
|
||||
tree gnu_field, gnu_field_list = NULL_TREE;
|
||||
tree gnu_get_parent;
|
||||
/* Set PACKED in keeping with gnat_to_gnu_field. */
|
||||
int packed
|
||||
const int packed
|
||||
= Is_Packed (gnat_entity)
|
||||
? 1
|
||||
: Component_Alignment (gnat_entity) == Calign_Storage_Unit
|
||||
|
|
@ -2926,13 +2928,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
&& Known_RM_Size (gnat_entity)))
|
||||
? -2
|
||||
: 0;
|
||||
bool has_discr = Has_Discriminants (gnat_entity);
|
||||
bool has_rep = Has_Specified_Layout (gnat_entity);
|
||||
bool all_rep = has_rep;
|
||||
bool is_extension
|
||||
const bool has_discr = Has_Discriminants (gnat_entity);
|
||||
const bool has_rep = Has_Specified_Layout (gnat_entity);
|
||||
const bool is_extension
|
||||
= (Is_Tagged_Type (gnat_entity)
|
||||
&& Nkind (record_definition) == N_Derived_Type_Definition);
|
||||
bool is_unchecked_union = Is_Unchecked_Union (gnat_entity);
|
||||
const bool is_unchecked_union = Is_Unchecked_Union (gnat_entity);
|
||||
bool all_rep = has_rep;
|
||||
|
||||
/* See if all fields have a rep clause. Stop when we find one
|
||||
that doesn't. */
|
||||
|
|
@ -3171,6 +3173,51 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
}
|
||||
}
|
||||
|
||||
/* If we have a derived untagged type that renames discriminants in
|
||||
the root type, the (stored) discriminants are a just copy of the
|
||||
discriminants of the root type. This means that any constraints
|
||||
added by the renaming in the derivation are disregarded as far
|
||||
as the layout of the derived type is concerned. To rescue them,
|
||||
we change the type of the (stored) discriminants to a subtype
|
||||
with the bounds of the type of the visible discriminants. */
|
||||
if (has_discr
|
||||
&& !is_extension
|
||||
&& Stored_Constraint (gnat_entity) != No_Elist)
|
||||
for (gnat_constr = First_Elmt (Stored_Constraint (gnat_entity));
|
||||
gnat_constr != No_Elmt;
|
||||
gnat_constr = Next_Elmt (gnat_constr))
|
||||
if (Nkind (Node (gnat_constr)) == N_Identifier
|
||||
/* Ignore access discriminants. */
|
||||
&& !Is_Access_Type (Etype (Node (gnat_constr)))
|
||||
&& Ekind (Entity (Node (gnat_constr))) == E_Discriminant)
|
||||
{
|
||||
Entity_Id gnat_discr = Entity (Node (gnat_constr));
|
||||
tree gnu_discr_type = gnat_to_gnu_type (Etype (gnat_discr));
|
||||
tree gnu_ref
|
||||
= gnat_to_gnu_entity (Original_Record_Component (gnat_discr),
|
||||
NULL_TREE, 0);
|
||||
|
||||
/* GNU_REF must be an expression using a PLACEHOLDER_EXPR built
|
||||
just above for one of the stored discriminants. */
|
||||
gcc_assert (TREE_TYPE (TREE_OPERAND (gnu_ref, 0)) == gnu_type);
|
||||
|
||||
if (gnu_discr_type != TREE_TYPE (gnu_ref))
|
||||
{
|
||||
const unsigned prec = TYPE_PRECISION (TREE_TYPE (gnu_ref));
|
||||
tree gnu_subtype
|
||||
= TYPE_UNSIGNED (TREE_TYPE (gnu_ref))
|
||||
? make_unsigned_type (prec) : make_signed_type (prec);
|
||||
TREE_TYPE (gnu_subtype) = TREE_TYPE (gnu_ref);
|
||||
TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
|
||||
SET_TYPE_RM_MIN_VALUE (gnu_subtype,
|
||||
TYPE_MIN_VALUE (gnu_discr_type));
|
||||
SET_TYPE_RM_MAX_VALUE (gnu_subtype,
|
||||
TYPE_MAX_VALUE (gnu_discr_type));
|
||||
TREE_TYPE (gnu_ref)
|
||||
= TREE_TYPE (TREE_OPERAND (gnu_ref, 1)) = gnu_subtype;
|
||||
}
|
||||
}
|
||||
|
||||
/* Add the fields into the record type and finish it up. */
|
||||
components_to_record (gnu_type, Component_List (record_definition),
|
||||
gnu_field_list, packed, definition, false,
|
||||
|
|
@ -5969,7 +6016,7 @@ elaborate_entity (Entity_Id gnat_entity)
|
|||
Present (gnat_field);
|
||||
gnat_field = Next_Discriminant (gnat_field),
|
||||
gnat_discriminant_expr = Next_Elmt (gnat_discriminant_expr))
|
||||
/* ??? For now, ignore access discriminants. */
|
||||
/* Ignore access discriminants. */
|
||||
if (!Is_Access_Type (Etype (Node (gnat_discriminant_expr))))
|
||||
elaborate_expression (Node (gnat_discriminant_expr),
|
||||
gnat_entity, get_entity_name (gnat_field),
|
||||
|
|
@ -7623,20 +7670,20 @@ build_subst_list (Entity_Id gnat_subtype, Entity_Id gnat_type, bool definition)
|
|||
{
|
||||
vec<subst_pair> gnu_list = vNULL;
|
||||
Entity_Id gnat_discrim;
|
||||
Node_Id gnat_value;
|
||||
Node_Id gnat_constr;
|
||||
|
||||
for (gnat_discrim = First_Stored_Discriminant (gnat_type),
|
||||
gnat_value = First_Elmt (Stored_Constraint (gnat_subtype));
|
||||
gnat_constr = First_Elmt (Stored_Constraint (gnat_subtype));
|
||||
Present (gnat_discrim);
|
||||
gnat_discrim = Next_Stored_Discriminant (gnat_discrim),
|
||||
gnat_value = Next_Elmt (gnat_value))
|
||||
gnat_constr = Next_Elmt (gnat_constr))
|
||||
/* Ignore access discriminants. */
|
||||
if (!Is_Access_Type (Etype (Node (gnat_value))))
|
||||
if (!Is_Access_Type (Etype (Node (gnat_constr))))
|
||||
{
|
||||
tree gnu_field = gnat_to_gnu_field_decl (gnat_discrim);
|
||||
tree replacement = convert (TREE_TYPE (gnu_field),
|
||||
elaborate_expression
|
||||
(Node (gnat_value), gnat_subtype,
|
||||
(Node (gnat_constr), gnat_subtype,
|
||||
get_entity_name (gnat_discrim),
|
||||
definition, true, false));
|
||||
subst_pair s = {gnu_field, replacement};
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
2013-05-24 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gnat.dg/derived_type4.adb: New test.
|
||||
|
||||
2013-05-24 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc.dg/builtin-bswap-6.c: New test.
|
||||
|
|
|
|||
16
gcc/testsuite/gnat.dg/derived_type4.adb
Normal file
16
gcc/testsuite/gnat.dg/derived_type4.adb
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
-- { dg-do compile }
|
||||
|
||||
procedure Derived_Type4 is
|
||||
|
||||
type Root (D : Positive) is record
|
||||
S : String (1 .. D);
|
||||
end record;
|
||||
|
||||
subtype Short is Positive range 1 .. 10;
|
||||
type Derived (N : Short := 1) is new Root (D => N);
|
||||
|
||||
Obj : Derived;
|
||||
|
||||
begin
|
||||
Obj := (N => 5, S => "Hello");
|
||||
end;
|
||||
Loading…
Add table
Reference in a new issue