decl.c (gnat_to_gnu_component_type): Force at least unit size for the component…

decl.c (gnat_to_gnu_component_type): Force at least unit size for the component size of an array with aliased components.

	* gcc-interface/decl.c (gnat_to_gnu_component_type): Force at least
	unit size for the component size of an array with aliased components.
	(maybe_pad_type): Do not warn for MAX_EXPR.

From-SVN: r152417

gcc/ada/ChangeLog

+2009-10-02  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/decl.c (gnat_to_gnu_component_type): Force at least
+	unit size for the component size of an array with aliased components.
+	(maybe_pad_type): Do not warn for MAX_EXPR.
+
 2009-09-29  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Factor out

gcc/ada/gcc-interface/decl.c

@@ -4990,6 +4990,17 @@ gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
 		     Is_Bit_Packed_Array (gnat_array) ? TYPE_DECL : VAR_DECL,
 		     true, Has_Component_Size_Clause (gnat_array));
 
+  /* If the array has aliased components and the component size can be zero,
+     force at least unit size to ensure that the components have distinct
+     addresses.  */
+  if (!gnu_comp_size
+      && Has_Aliased_Components (gnat_array)
+      && (integer_zerop (TYPE_SIZE (gnu_type))
+	  || (TREE_CODE (gnu_type) == ARRAY_TYPE
+	      && !TREE_CONSTANT (TYPE_SIZE (gnu_type)))))
+    gnu_comp_size
+      = size_binop (MAX_EXPR, TYPE_SIZE (gnu_type), bitsize_unit_node);
+
   /* If the component type is a RECORD_TYPE that has a self-referential size,
      then use the maximum size for the component size.  */
   if (!gnu_comp_size
@@ -6210,6 +6221,7 @@ maybe_pad_type (tree type, tree size, unsigned int align,
 
   if (Present (gnat_entity)
       && size
+      && TREE_CODE (size) != MAX_EXPR
       && !operand_equal_p (size, orig_size, 0)
       && !(TREE_CODE (size) == INTEGER_CST
 	   && TREE_CODE (orig_size) == INTEGER_CST

gcc/testsuite/ChangeLog

 2009-10-02  Eric Botcazou  <ebotcazou@adacore.com>
 
+	* gnat.dg/array11.adb: New test.
+	* gnat.dg/array12.adb: Likewise.
+
+2009-10-02  Eric Botcazou  <ebotcazou@adacore.com>
+
 	* gnat.dg/array10.adb: New test.
 	* gnat.dg/object_overflow.adb: Tweak.
 

gcc/testsuite/gnat.dg/array11.adb

+-- { dg-do compile }
+
+procedure Array11 is
+
+  type Rec is null record;
+  type Ptr is access all Rec;
+
+  type Arr1 is array (1..8) of aliased Rec; -- { dg-warning "padded" }
+  type Arr2 is array (Long_Integer) of aliased Rec; -- { dg-warning "padded" }
+
+  A1 : Arr1;
+  A2 : Arr2; -- { dg-warning "Storage_Error will be raised" }
+
+begin
+  null;
+end;

gcc/testsuite/gnat.dg/array12.adb

+-- { dg-do run }
+
+procedure Array12 is
+
+  function N return Integer is
+  begin
+    return 0;
+  end;
+
+  subtype Element is String (1 .. N);
+  type Ptr is access all Element;
+  type Vector is array (Positive range <>) of aliased Element;
+
+  V : Vector (1..2);
+
+begin
+  if Ptr'(V(1)'Access) = V(2)'Access then
+    raise Program_Error;
+  end if;
+end;