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

	* 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

5 files changed, 96 insertions, 44 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index e41daae..5b143ae 100644
--- 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
--- 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
--- 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
index 0000000..199855f5
--- /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 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;