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

	* 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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e41daae..5b143ae 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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

diff --git a/gcc/ada/decl.c b/gcc/ada/decl.c
index b8bcb4b..dbd7970 100644 (file)
--- 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 68e98fc..d0e0a73 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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):

diff --git a/gcc/testsuite/gnat.dg/discr9.adb b/gcc/testsuite/gnat.dg/discr9.adb
new file mode 100644 (file)
index 0000000..199855f
--- /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 (file)
index 0000000..5edde81
--- /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;