[Ada] Fix incorrect assignment to array with Component_Size clause

Message ID 20171215140956.GA95965@adacore.com
State New
Headers show
Series
  • [Ada] Fix incorrect assignment to array with Component_Size clause
Related show

Commit Message

Pierre-Marie de Rodat Dec. 15, 2017, 2:09 p.m.
This change fixes a wrong translation of the assignment of an aggregate
made up of a single Others choice to an array whose nominal size of the
component type is the storage unit and which is subject to a Component_Size
clause that effectively bumps this size.

The compiler was generating a call to memset in this case, which filled
the gap between the nominal size and the component size with copies of
the single Others value instead of zero/sign-extending it appropriately.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

2017-12-15  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_aggr.adb: Fix for QC04-027 (incorrect assignment to array
	with Component_Size clause):

	* exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Use
	Component_Size of the innermost array instead of Esize of its
	component type to exclude inappropriate array types, including
	packed array types.

gcc/testsuite/

2017-12-15  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/component_size.adb: New testcase.

Patch

Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb	(revision 255693)
+++ exp_aggr.adb	(working copy)
@@ -4895,14 +4895,14 @@ 
 
       --    1. N consists of a single OTHERS choice, possibly recursively
 
-      --    2. The array type is not packed
+      --    2. The array type has no null ranges (the purpose of this is to
+      --       avoid a bogus warning for an out-of-range value).
 
       --    3. The array type has no atomic components
 
-      --    4. The array type has no null ranges (the purpose of this is to
-      --       avoid a bogus warning for an out-of-range value).
+      --    4. The component type is elementary
 
-      --    5. The component type is elementary
+      --    5. The component size is a multiple of Storage_Unit
 
       --    6. The component size is Storage_Unit or the value is of the form
       --       M * (1 + A**1 + A**2 + .. A**(K-1)) where A = 2**(Storage_Unit)
@@ -4918,6 +4918,7 @@ 
          Expr      : Node_Id := N;
          Low       : Node_Id;
          High      : Node_Id;
+         Csiz      : Uint;
          Remainder : Uint;
          Value     : Uint;
          Nunits    : Nat;
@@ -4933,14 +4934,6 @@ 
                return False;
             end if;
 
-            if Present (Packed_Array_Impl_Type (Ctyp)) then
-               return False;
-            end if;
-
-            if Has_Atomic_Components (Ctyp) then
-               return False;
-            end if;
-
             Index := First_Index (Ctyp);
             while Present (Index) loop
                Get_Index_Bounds (Index, Low, High);
@@ -4964,6 +4957,11 @@ 
                Expr := Expression (First (Component_Associations (Expr)));
             end loop;
 
+            if Has_Atomic_Components (Ctyp) then
+               return False;
+            end if;
+
+            Csiz := Component_Size (Ctyp);
             Ctyp := Component_Type (Ctyp);
 
             if Is_Atomic_Or_VFA (Ctyp) then
@@ -4978,20 +4976,19 @@ 
             return False;
          end if;
 
-         --  All elementary types are supported
+         --  Access types need to be dealt with specially
 
-         if not Is_Elementary_Type (Ctyp) then
-            return False;
-         end if;
+         if Is_Access_Type (Ctyp) then
 
-         --  However access types need to be dealt with specially
+            --  Component_Size is not set by Layout_Type if the component
+            --  type is an access type ???
 
-         if Is_Access_Type (Ctyp) then
+            Csiz := Esize (Ctyp);
 
             --  Fat pointers are rejected as they are not really elementary
             --  for the backend.
 
-            if Esize (Ctyp) /= System_Address_Size then
+            if Csiz /= System_Address_Size then
                return False;
             end if;
 
@@ -5002,16 +4999,27 @@ 
             if Nkind (Expr) /= N_Null and then not Is_Entity_Name (Expr) then
                return False;
             end if;
+
+         --  Scalar types are OK if their size is a multiple of Storage_Unit
+
+         elsif Is_Scalar_Type (Ctyp) then
+
+            if Csiz mod System_Storage_Unit /= 0 then
+               return False;
+            end if;
+
+         --  Composite types are rejected
+
+         else
+            return False;
          end if;
 
          --  The expression needs to be analyzed if True is returned
 
          Analyze_And_Resolve (Expr, Ctyp);
 
-         --  The back end uses the Esize as the precision of the type
+         Nunits := UI_To_Int (Csiz) / System_Storage_Unit;
 
-         Nunits := UI_To_Int (Esize (Ctyp)) / System_Storage_Unit;
-
          if Nunits = 1 then
             return True;
          end if;
Index: ../testsuite/gnat.dg/component_size.adb
===================================================================
--- ../testsuite/gnat.dg/component_size.adb	(revision 0)
+++ ../testsuite/gnat.dg/component_size.adb	(revision 0)
@@ -0,0 +1,37 @@ 
+--  { dg-do run }
+
+procedure Component_Size is
+
+   C_Unsigned_Long_Size : constant := 32;
+   type T_Unsigned_Long is range 0 .. (2 ** 31) - 1;
+   for T_Unsigned_Long'Size use C_Unsigned_Long_Size;
+
+   C_Unsigned_Byte_Size : constant := 8;
+   type T_Unsigned_Byte is range 0 .. (2 ** 8) - 1;
+   for T_Unsigned_Byte'Size use C_Unsigned_Byte_Size;
+
+   type T_Unsigned_Byte_Without_Size_Repr is range 0 .. (2 ** 8) - 1;
+
+   C_Nb_Data : constant T_Unsigned_Long := 9;
+   subtype T_Nb_Data is T_Unsigned_Long range 1 .. C_Nb_Data;
+   
+   type T_Wrong_Id is array (T_Nb_Data) of T_Unsigned_Byte;
+   for T_Wrong_Id'Component_Size use C_Unsigned_Long_Size;
+
+   type T_Correct_Id is array (T_Nb_Data) of T_Unsigned_Byte_Without_Size_Repr;
+   for T_Correct_Id'Component_Size use C_Unsigned_Long_Size;  
+
+   C_Value : constant := 1;
+
+   C_Wrong_Id : constant T_Wrong_Id := T_Wrong_Id'(others => C_Value);
+   C_Correct_Id : constant T_Correct_Id := T_Correct_Id'(others => C_Value);
+
+begin
+   if C_Correct_Id /= T_Correct_Id'(others => C_Value) then
+      raise Program_Error;
+   end if;
+
+   if C_Wrong_Id /= T_Wrong_Id'(others => C_Value) then
+      raise Program_Error;
+   end if;
+end;