From: Eric Botcazou Date: Fri, 24 May 2013 08:27:55 +0000 (+0000) Subject: decl.c (gnat_to_gnu_entity): Constify a handful of local variables. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=908ba941c3abc6b8ed507871a9051bd5b9cde98d;p=gcc.git decl.c (gnat_to_gnu_entity): Constify a handful of local variables. * gcc-interface/decl.c (gnat_to_gnu_entity) : 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2c10c68653c..d7e6209746a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2013-05-24 Eric Botcazou + + * gcc-interface/decl.c (gnat_to_gnu_entity) : 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 * gcc-interface/Make-lang.in (gnat1$(exeext)): Use link mutex. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 98653243b80..b859731231c 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -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 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}; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 521873ceacd..f9ef3c062a7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2013-05-24 Eric Botcazou + + * gnat.dg/derived_type4.adb: New test. + 2013-05-24 Eric Botcazou * gcc.dg/builtin-bswap-6.c: New test. diff --git a/gcc/testsuite/gnat.dg/derived_type4.adb b/gcc/testsuite/gnat.dg/derived_type4.adb new file mode 100644 index 00000000000..22c41ecc648 --- /dev/null +++ b/gcc/testsuite/gnat.dg/derived_type4.adb @@ -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;