utils.c (aggregate_type_contains_array_p): New predicate.

* utils.c (aggregate_type_contains_array_p): New predicate.
	(create_field_decl): In a packed record, force byte alignment
	for fields without specified position that contain an array.

From-SVN: r131498

gcc/ada/ChangeLog

@@ -1,3 +1,9 @@
+2008-01-12  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* utils.c (aggregate_type_contains_array_p): New predicate.
+	(create_field_decl): In a packed record, force byte alignment
+	for fields without specified position that contain an array.
+
 2008-01-12  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* utils.c (unchecked_convert): Fold the VIEW_CONVERT_EXPR expression.

gcc/ada/utils.c

@@ -1509,6 +1509,33 @@ create_true_var_decl (tree var_name, tree asm_name, tree type, tree var_init,
 			    attr_list, gnat_node);
 }
 
+/* Return true if TYPE, an aggregate type, contains (or is) an array.  */
+
+static bool
+aggregate_type_contains_array_p (tree type)
+{
+  switch (TREE_CODE (type))
+    {
+    case RECORD_TYPE:
+    case UNION_TYPE:
+    case QUAL_UNION_TYPE:
+      {
+	tree field;
+	for (field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field))
+	  if (AGGREGATE_TYPE_P (TREE_TYPE (field))
+	      && aggregate_type_contains_array_p (TREE_TYPE (field)))
+	    return true;
+	return false;
+      }
+
+    case ARRAY_TYPE:
+      return true;
+    
+    default:
+      gcc_unreachable ();
+    }
+}
+
 /* Returns a FIELD_DECL node. FIELD_NAME the field name, FIELD_TYPE is its
    type, and RECORD_TYPE is the type of the parent.  PACKED is nonzero if
    this field is in a record type with a "pragma pack".  If SIZE is nonzero
@@ -1527,8 +1554,15 @@ create_field_decl (tree field_name, tree field_type, tree record_type,
   TREE_READONLY (field_decl) = TYPE_READONLY (field_type);
 
   /* If FIELD_TYPE is BLKmode, we must ensure this is aligned to at least a
-     byte boundary since GCC cannot handle less-aligned BLKmode bitfields.  */
-  if (packed && TYPE_MODE (field_type) == BLKmode)
+     byte boundary since GCC cannot handle less-aligned BLKmode bitfields.
+     Likewise for an aggregate without specified position that contains an
+     array, because in this case slices of variable length of this array
+     must be handled by GCC and variable-sized objects need to be aligned
+     to at least a byte boundary.  */
+  if (packed && (TYPE_MODE (field_type) == BLKmode
+		 || (!pos
+		     && AGGREGATE_TYPE_P (field_type)
+		     && aggregate_type_contains_array_p (field_type))))
     DECL_ALIGN (field_decl) = BITS_PER_UNIT;
 
   /* If a size is specified, use it.  Otherwise, if the record type is packed

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2008-01-12  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/slice3.adb: New test.
+	* gnat.dg/slice4.adb: Likewise.
+
 2008-01-12  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gnat.dg/bit_packed_array.ad[sb]: New test.

gcc/testsuite/gnat.dg/slice3.adb

@@ -0,0 +1,24 @@
+-- { dg-do run }
+
+procedure Slice3 is
+
+   type Varray is array (1 .. 1) of Natural;  -- SImode
+
+   type Sample is record
+      Maybe  : Boolean;
+      Values : Varray;
+   end record;
+   pragma Pack (Sample);
+
+   function Match (X, Y: Sample; Length : Positive) return Boolean is
+   begin
+      return X.Values (1 .. Length) = Y.Values (1 .. Length);
+   end;
+
+   X, Y : Sample := (Maybe => True, Values => (1 => 1));
+begin
+   X.Maybe := False;
+   if not Match (X, Y, 1) then
+      raise Program_Error;
+   end if;
+end;

gcc/testsuite/gnat.dg/slice4.adb

@@ -0,0 +1,28 @@
+-- { dg-do run }
+
+procedure Slice4 is
+
+   type Varray is array (1 .. 1) of Natural;  -- SImode
+
+   type Rec is record
+      Values : Varray;
+   end record;
+
+   type Sample is record
+      Maybe  : Boolean;
+      R : Rec;
+   end record;
+   pragma Pack (Sample);
+
+   function Match (X, Y: Sample; Length : Positive) return Boolean is
+   begin
+      return X.R.Values (1 .. Length) = Y.R.Values (1 .. Length);
+   end;
+
+   X, Y : Sample := (Maybe => True, R => (Values => (1 => 1)));
+begin
+   X.Maybe := False;
+   if not Match (X, Y, 1) then
+      raise Program_Error;
+   end if;
+end;