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

	* 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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f0577bd..967e4f0 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 3fb7c80..22ee89e 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a7739b8..f2dba40 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 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.
 

diff --git a/gcc/testsuite/gnat.dg/array11.adb b/gcc/testsuite/gnat.dg/array11.adb
new file mode 100644 (file)
index 0000000..0a7edcf
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/array11.adb
@@ -0,0 +1,16 @@
+-- { 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;

diff --git a/gcc/testsuite/gnat.dg/array12.adb b/gcc/testsuite/gnat.dg/array12.adb
new file mode 100644 (file)
index 0000000..3748d5e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/array12.adb
@@ -0,0 +1,20 @@
+-- { 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;