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 <ebotca...@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 <ebotca...@adacore.com>
* gnat.dg/component_size.adb: New testcase.
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;
