[Ada] Fix ICE on array slices in packed records

[Eric Botcazou <ebotcazou at adacore dot com>]

The bug only occurs for arrays whose total size matches one of the integral 
mode: in this case, the layout engine gives them this integral mode (at least 
on non strict-alignment platforms), which means that they can be bit-packed.
In the other cases, the mode is BLKmode and the arrays are only byte-packed.

When slices of variable length of these arrays are taken, assignment and 
comparison are implemented with memcpy and memcmp, which means that their 
address is requested and that they need to be aligned to a byte boudary.

The patch arranges for always only byte-packing these arrays.

Bootstrapped/regtested on i586-suse-linux, applied on the mainline.


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>

        * gnat.dg/slice3.adb: New test.
	* gnat.dg/slice4.adb: Likewise.


-- 
Eric Botcazou

Index: utils.c
===================================================================
--- utils.c	(revision 131493)
+++ utils.c	(working copy)
@@ -1509,6 +1509,33 @@ create_true_var_decl (tree var_name, tre
 			    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
   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

-- { 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;

-- { 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;