From fb149ebdfee8995ed091f17cd64355ff54e9fb30 Mon Sep 17 00:00:00 2001
From: Eric Botcazou <ebotcazou@gcc.gnu.org>
Date: Mon, 15 Jun 2020 19:42:11 +0200
Subject: [PATCH] Fix ICE in verify_sra_access_forest

This fixes an issue with reverse storage order in SRA, which is caught
by the built-in verifier in verify_sra_access_forest.  The problem is
that propagate_subaccesses_from_rhs changes the type of an access
from aggregate to scalar and, as discussed elsewhere, this must be
done with extra care in the presence of reverse storage order.

gcc/ChangeLog
	* tree-sra.c (propagate_subaccesses_from_rhs): When a non-scalar
	access on the LHS is replaced with a scalar access, propagate the
	TYPE_REVERSE_STORAGE_ORDER flag of the type of the original access.

gcc/testsuite/ChangeLog
	* gnat.dg/opt85.ads, gnat.dg/opt85.adb: New test.
---
 gcc/testsuite/gnat.dg/opt85.adb | 20 ++++++++++++++++++++
 gcc/testsuite/gnat.dg/opt85.ads | 27 +++++++++++++++++++++++++++
 gcc/tree-sra.c                  |  6 ++++++
 3 files changed, 53 insertions(+)
 create mode 100644 gcc/testsuite/gnat.dg/opt85.adb
 create mode 100644 gcc/testsuite/gnat.dg/opt85.ads

diff --git a/gcc/testsuite/gnat.dg/opt85.adb b/gcc/testsuite/gnat.dg/opt85.adb
new file mode 100644
index 00000000000..94213a45819
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt85.adb
@@ -0,0 +1,20 @@
+-- { dg-do compile }
+-- { dg-options "-O" }
+
+package body Opt85 is
+
+   function Conversion_Of (Value : Integer) return Data_Type is
+   begin
+      return (Value => Interfaces.Integer_16 (Value));
+   end;
+
+   function Create (Value : Integer) return Record_Type is
+      Rec : constant Record_Type :=
+        (Ada.Finalization.Controlled with
+         Header => (others => False),
+         Data   => Conversion_Of (Value));
+   begin
+      return Rec;
+   end;
+
+end Opt85;
diff --git a/gcc/testsuite/gnat.dg/opt85.ads b/gcc/testsuite/gnat.dg/opt85.ads
new file mode 100644
index 00000000000..00b5c284da8
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt85.ads
@@ -0,0 +1,27 @@
+with Ada.Finalization;
+with Interfaces;
+with System;
+
+package Opt85 is
+
+   type Data_Type is record
+      Value : Interfaces.Integer_16;
+   end record;
+   for Data_Type use record
+      Value at 0 range 0 .. 15;
+   end record;
+   for Data_Type'Alignment use 1;
+   for Data_Type'Size use 2 * System.Storage_Unit;
+   for Data_Type'Bit_Order use System.High_Order_First;
+   for Data_Type'Scalar_Storage_Order use System.High_Order_First;
+
+   type Header_Type is array (1 .. 1) of Boolean;
+
+   type Record_Type is new Ada.Finalization.Controlled with record
+      Header : Header_Type;
+      Data   : Data_Type;
+   end record;
+
+   function Create (Value : Integer) return Record_Type;
+
+end Opt85;
diff --git a/gcc/tree-sra.c b/gcc/tree-sra.c
index 4793b48f32c..fcba7fbdd31 100644
--- a/gcc/tree-sra.c
+++ b/gcc/tree-sra.c
@@ -2758,6 +2758,9 @@ propagate_subaccesses_from_rhs (struct access *lacc, struct access *racc)
 	}
       if (!lacc->first_child && !racc->first_child)
 	{
+	  /* We are about to change the access type from aggregate to scalar,
+	     so we need to put the reverse flag onto the access, if any.  */
+	  const bool reverse = TYPE_REVERSE_STORAGE_ORDER (lacc->type);
 	  tree t = lacc->base;
 
 	  lacc->type = racc->type;
@@ -2772,9 +2775,12 @@ propagate_subaccesses_from_rhs (struct access *lacc, struct access *racc)
 	      lacc->expr = build_ref_for_model (EXPR_LOCATION (lacc->base),
 						lacc->base, lacc->offset,
 						racc, NULL, false);
+	      if (TREE_CODE (lacc->expr) == MEM_REF)
+		REF_REVERSE_STORAGE_ORDER (lacc->expr) = reverse;
 	      lacc->grp_no_warning = true;
 	      lacc->grp_same_access_path = false;
 	    }
+	  lacc->reverse = reverse;
 	}
       return ret;
     }