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.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-08-12 Eric Botcazou <ebotca...@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.--- gcc/ada/exp_ch4.adb
+++ gcc/ada/exp_ch4.adb
@@ -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;
--- gcc/ada/exp_ch6.adb
+++ gcc/ada/exp_ch6.adb
@@ -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);
--- gcc/ada/exp_util.adb
+++ gcc/ada/exp_util.adb
@@ -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
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/slice10.adb
@@ -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;
