From: Eric Botcazou Date: Thu, 12 Jun 2008 13:19:06 +0000 (+0000) Subject: decl.c (gnat_to_gnu_entity): In the case of a constrained subtype of a discriminated... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=1dd4a3e6378a4f20d7c6ce9ef588e65cbe0e38e7;p=gcc.git decl.c (gnat_to_gnu_entity): In the case of a constrained subtype of a discriminated type... * decl.c (gnat_to_gnu_entity) : 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e41daae22e7..5b143ae820a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2008-06-12 Eric Botcazou + + * decl.c (gnat_to_gnu_entity) : 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 * utils.c (create_subprog_decl): If this is for the 'main' entry diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c index b8bcb4bc85d..dbd797089fa 100644 --- a/gcc/ada/decl.c +++ b/gcc/ada/decl.c @@ -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. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 68e98fc48f6..d0e0a736abb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2008-06-12 Eric Botcazou + + * gnat.dg/discr9.ad[sb]: New test. + 2008-06-12 Joseph Myers * gcc.dg/compat/struct-layout-1.exp (orig_gcc_exec_prefix_saved): diff --git a/gcc/testsuite/gnat.dg/discr9.adb b/gcc/testsuite/gnat.dg/discr9.adb new file mode 100644 index 00000000000..199855f57fc --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr9.adb @@ -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; diff --git a/gcc/testsuite/gnat.dg/discr9.ads b/gcc/testsuite/gnat.dg/discr9.ads new file mode 100644 index 00000000000..5edde81bff8 --- /dev/null +++ b/gcc/testsuite/gnat.dg/discr9.ads @@ -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;