[Ada] Fix internal error on comparison of unaligned slices

This fixes an internal error in the code generator when it is trying to
take the address of a slice which does not start on a byte boundary, in
order to generate a comparison between slices with a dynamic length.

This case is not supported by the code generator and comes from an
explicit representation clause on a record type, so it must be detected
and handled by the front-end by expanding the comparison on an
element-by-element basis.

2019-08-12  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_ch4.adb (Expand_N_Op_Eq): Expand the array equality if
	either operand is a possibly unaligned slice.
	* exp_ch6.adb (Expand_Simple_Function_Return): Do not generate a
	copy for a possibly unaligned object if it is represented as a
	scalar.
	* exp_util.adb (Is_Possibly_Unaligned_Slice): Do not always
	return false if the target doesn't have strict alignment.

gcc/testsuite/

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

From-SVN: r274303
This commit is contained in:
Eric Botcazou 2019-08-12 09:01:33 +00:00 committed by Pierre-Marie de Rodat
parent ad43078608
commit 009070260d
6 changed files with 54 additions and 14 deletions

View File

@ -1,3 +1,13 @@
2019-08-12 Eric Botcazou <ebotcazou@adacore.com>
* exp_ch4.adb (Expand_N_Op_Eq): Expand the array equality if
either operand is a possibly unaligned slice.
* exp_ch6.adb (Expand_Simple_Function_Return): Do not generate a
copy for a possibly unaligned object if it is represented as a
scalar.
* exp_util.adb (Is_Possibly_Unaligned_Slice): Do not always
return false if the target doesn't have strict alignment.
2019-08-12 Bob Duff <duff@adacore.com>
* sem_ch12.adb (Instantiate_Package_Body): Remove suppression of

View File

@ -8068,7 +8068,9 @@ package body Exp_Ch4 is
and then not Is_Floating_Point_Type (Component_Type (Typl))
and then not Is_Atomic_Or_VFA (Component_Type (Typl))
and then not Is_Possibly_Unaligned_Object (Lhs)
and then not Is_Possibly_Unaligned_Slice (Lhs)
and then not Is_Possibly_Unaligned_Object (Rhs)
and then not Is_Possibly_Unaligned_Slice (Rhs)
and then Support_Composite_Compare_On_Target
then
null;

View File

@ -203,8 +203,8 @@ package body Exp_Ch6 is
-- For all parameter modes, actuals that denote components and slices of
-- packed arrays are expanded into suitable temporaries.
--
-- For non-scalar objects that are possibly unaligned, add call by copy
-- code (copy in for IN and IN OUT, copy out for OUT and IN OUT).
-- For nonscalar objects that are possibly unaligned, add call by copy code
-- (copy in for IN and IN OUT, copy out for OUT and IN OUT).
--
-- For OUT and IN OUT parameters, add predicate checks after the call
-- based on the predicates of the actual type.
@ -2019,7 +2019,7 @@ package body Exp_Ch6 is
elsif Is_Ref_To_Bit_Packed_Array (Actual) then
Add_Simple_Call_By_Copy_Code;
-- If a non-scalar actual is possibly bit-aligned, we need a copy
-- If a nonscalar actual is possibly bit-aligned, we need a copy
-- because the back-end cannot cope with such objects. In other
-- cases where alignment forces a copy, the back-end generates
-- it properly. It should not be generated unconditionally in the
@ -2235,7 +2235,7 @@ package body Exp_Ch6 is
elsif Is_Ref_To_Bit_Packed_Array (Actual) then
Add_Simple_Call_By_Copy_Code;
-- If a non-scalar actual is possibly unaligned, we need a copy
-- If a nonscalar actual is possibly unaligned, we need a copy
elsif Is_Possibly_Unaligned_Object (Actual)
and then not Represented_As_Scalar (Etype (Formal))
@ -7413,12 +7413,13 @@ package body Exp_Ch6 is
end;
end if;
-- If we are returning an object that may not be bit-aligned, then copy
-- the value into a temporary first. This copy may need to expand to a
-- loop of component operations.
-- If we are returning a nonscalar object that is possibly unaligned,
-- then copy the value into a temporary first. This copy may need to
-- expand to a loop of component operations.
if Is_Possibly_Unaligned_Slice (Exp)
or else Is_Possibly_Unaligned_Object (Exp)
or else (Is_Possibly_Unaligned_Object (Exp)
and then not Represented_As_Scalar (Etype (Exp)))
then
declare
ExpR : constant Node_Id := Relocate_Node (Exp);

View File

@ -8485,12 +8485,6 @@ package body Exp_Util is
return False;
end if;
-- We only need to worry if the target has strict alignment
if not Target_Strict_Alignment then
return False;
end if;
-- If it is a slice, then look at the array type being sliced
declare

View File

@ -1,3 +1,7 @@
2019-08-12 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/slice10.adb: New testcase.
2019-08-12 Gary Dismukes <dismukes@adacore.com>
* gnat.dg/generic_inst7.adb, gnat.dg/generic_inst7_pkg.adb,

View File

@ -0,0 +1,29 @@
-- { dg-do run }
procedure Slice10 is
subtype Str is String (1 .. 3);
type T is record
B : Boolean;
S : Str;
end record;
for T use record
B at 0 range 0 .. 0;
S at 0 range 1 .. 24;
end record;
function Match (X, Y: T; Length : Positive) return Boolean is
begin
return X.S (1 .. Length) = Y.S (1 .. Length);
end;
X, Y : T := (B => True, S => "123");
begin
X.B := False;
if not match (X, Y, 3) then
raise Program_Error;
end if;
end;