[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

6 files changed, 54 insertions, 14 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f2870e8..fa543df 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 43be9c9..6f2fe32 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/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;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 3f2d0e3..4ba9d84 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/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);
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index b677a72..2a3132b 100644
--- a/gcc/ada/exp_util.adb
+++ b/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
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f7f6276..ee65d1b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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,
diff --git a/gcc/testsuite/gnat.dg/slice10.adb b/gcc/testsuite/gnat.dg/slice10.adb
new file mode 100644
index 0000000..4793258
--- /dev/null
+++ b/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;