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.

diff --git a/gcc/testsuite/gnat.dg/opt85.adb b/gcc/testsuite/gnat.dg/opt85.adb
new file mode 100644 (file)
index 0000000..94213a4
--- /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 (file)
index 0000000..00b5c28
--- /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 4793b48f32c4d048ba50d471f50d8ac1354563cf..fcba7fbdd31339a6b90c7c82da7cd6706fbd6f2c 100644 (file)
--- 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;
     }