Two aliased objects must have distinct addresses, even if they have size zero, 
so we make sure to allocate at least one byte for them.

Tested on x86-64/Linux, applied on the mainline.


2020-05-08  Eric Botcazou  <ebotca...@adacore.com>

        * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Force at
        least the unit size for an aliased object of a constrained nominal
        subtype whose size is variable.


2020-05-08  Eric Botcazou  <ebotca...@adacore.com>

        * gnat.dg/addr15.adb: New test.

-- 
Eric Botcazou
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index a4053eec839..9c1acd9f23f 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -969,10 +969,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	  align = MINIMUM_ATOMIC_ALIGNMENT;
 #endif
 
-	/* Make a new type with the desired size and alignment, if needed.
-	   But do not take into account alignment promotions to compute the
-	   size of the object.  */
+	/* Do not take into account aliased adjustments or alignment promotions
+	   to compute the size of the object.  */
 	tree gnu_object_size = gnu_size ? gnu_size : TYPE_SIZE (gnu_type);
+
+	/* If the object is aliased, of a constrained nominal subtype and its
+	   size might be zero at run time, we force at least the unit size.  */
+	if (Is_Aliased (gnat_entity)
+	    && !Is_Constr_Subt_For_UN_Aliased (gnat_type)
+	    && Is_Array_Type (Underlying_Type (gnat_type))
+	    && !TREE_CONSTANT (gnu_object_size))
+	  gnu_size = size_binop (MAX_EXPR, gnu_object_size, bitsize_unit_node);
+
+	/* Make a new type with the desired size and alignment, if needed.  */
 	if (gnu_size || align > 0)
 	  {
 	    tree orig_type = gnu_type;
--  { dg-do run }

with System; use System;

procedure Addr15 is

  function Get_Bound (Param : Integer) return Integer is (Param);

  type Alpha_Typ is array (1 .. Get_Bound (1)) of Integer;
  type Beta_Typ  is array (1 .. Get_Bound (0)) of Integer;

  Alpha : Alpha_Typ;
  Beta  : aliased Beta_Typ;

begin
  if Alpha'Address = Beta'Address then
    raise Program_Error;
  end if;
end;

Reply via email to