Commit 00907026 by Eric Botcazou Committed by Pierre-Marie de Rodat

[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
parent ad430786
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> 2019-08-12 Bob Duff <duff@adacore.com>
* sem_ch12.adb (Instantiate_Package_Body): Remove suppression of * sem_ch12.adb (Instantiate_Package_Body): Remove suppression of
......
...@@ -8068,7 +8068,9 @@ package body Exp_Ch4 is ...@@ -8068,7 +8068,9 @@ package body Exp_Ch4 is
and then not Is_Floating_Point_Type (Component_Type (Typl)) and then not Is_Floating_Point_Type (Component_Type (Typl))
and then not Is_Atomic_Or_VFA (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_Object (Lhs)
and then not Is_Possibly_Unaligned_Slice (Lhs)
and then not Is_Possibly_Unaligned_Object (Rhs) and then not Is_Possibly_Unaligned_Object (Rhs)
and then not Is_Possibly_Unaligned_Slice (Rhs)
and then Support_Composite_Compare_On_Target and then Support_Composite_Compare_On_Target
then then
null; null;
......
...@@ -203,8 +203,8 @@ package body Exp_Ch6 is ...@@ -203,8 +203,8 @@ package body Exp_Ch6 is
-- For all parameter modes, actuals that denote components and slices of -- For all parameter modes, actuals that denote components and slices of
-- packed arrays are expanded into suitable temporaries. -- packed arrays are expanded into suitable temporaries.
-- --
-- For non-scalar objects that are possibly unaligned, add call by copy -- For nonscalar objects that are possibly unaligned, add call by copy code
-- code (copy in for IN and IN OUT, copy out for OUT and IN OUT). -- (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 -- For OUT and IN OUT parameters, add predicate checks after the call
-- based on the predicates of the actual type. -- based on the predicates of the actual type.
...@@ -2019,7 +2019,7 @@ package body Exp_Ch6 is ...@@ -2019,7 +2019,7 @@ package body Exp_Ch6 is
elsif Is_Ref_To_Bit_Packed_Array (Actual) then elsif Is_Ref_To_Bit_Packed_Array (Actual) then
Add_Simple_Call_By_Copy_Code; 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 -- because the back-end cannot cope with such objects. In other
-- cases where alignment forces a copy, the back-end generates -- cases where alignment forces a copy, the back-end generates
-- it properly. It should not be generated unconditionally in the -- it properly. It should not be generated unconditionally in the
...@@ -2235,7 +2235,7 @@ package body Exp_Ch6 is ...@@ -2235,7 +2235,7 @@ package body Exp_Ch6 is
elsif Is_Ref_To_Bit_Packed_Array (Actual) then elsif Is_Ref_To_Bit_Packed_Array (Actual) then
Add_Simple_Call_By_Copy_Code; 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) elsif Is_Possibly_Unaligned_Object (Actual)
and then not Represented_As_Scalar (Etype (Formal)) and then not Represented_As_Scalar (Etype (Formal))
...@@ -7413,12 +7413,13 @@ package body Exp_Ch6 is ...@@ -7413,12 +7413,13 @@ package body Exp_Ch6 is
end; end;
end if; end if;
-- If we are returning an object that may not be bit-aligned, then copy -- If we are returning a nonscalar object that is possibly unaligned,
-- the value into a temporary first. This copy may need to expand to a -- then copy the value into a temporary first. This copy may need to
-- loop of component operations. -- expand to a loop of component operations.
if Is_Possibly_Unaligned_Slice (Exp) 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 then
declare declare
ExpR : constant Node_Id := Relocate_Node (Exp); ExpR : constant Node_Id := Relocate_Node (Exp);
......
...@@ -8485,12 +8485,6 @@ package body Exp_Util is ...@@ -8485,12 +8485,6 @@ package body Exp_Util is
return False; return False;
end if; 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 -- If it is a slice, then look at the array type being sliced
declare declare
......
2019-08-12 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/slice10.adb: New testcase.
2019-08-12 Gary Dismukes <dismukes@adacore.com> 2019-08-12 Gary Dismukes <dismukes@adacore.com>
* gnat.dg/generic_inst7.adb, gnat.dg/generic_inst7_pkg.adb, * gnat.dg/generic_inst7.adb, gnat.dg/generic_inst7_pkg.adb,
......
-- { 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment