[Ada] Fix internal error on comparison of unaligned slices

[Ada] Fix internal error on comparison of unaligned slices

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 978 bytes --]

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  <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.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 4027 bytes --]

--- 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;