From: Eric Botcazou <ebotcazou@adacore.com>
Date: Sun, 27 Jan 2019 18:16:23 +0000 (+0000)
Subject: decl.c (array_type_has_nonaliased_component): Return the same value for every dimensi... 
X-Git-Tag: releases/gcc-7.5.0~633
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=917c0e9176af5e79ff8bfd79682acdc3df4333e5;p=thirdparty%2Fgcc.git

decl.c (array_type_has_nonaliased_component): Return the same value for every dimension of a multidimensional array type.

	* gcc-interface/decl.c (array_type_has_nonaliased_component): Return
	the same value for every dimension of a multidimensional array type.

From-SVN: r268316
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 27719e695582..e5adc7f53e0e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2019-01-27  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/decl.c (array_type_has_nonaliased_component): Return
+	the same value for every dimension of a multidimensional array type.
+
 2019-01-26  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/trans.c (gnat_to_gnu) <N_Assignment_Statement>: Use
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index bf3269af5345..acd7fc5ddc88 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -6341,12 +6341,6 @@ same_discriminant_p (Entity_Id discr1, Entity_Id discr2)
 static bool
 array_type_has_nonaliased_component (tree gnu_type, Entity_Id gnat_type)
 {
-  /* If the array type is not the innermost dimension of the GNAT type,
-     then it has a non-aliased component.  */
-  if (TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE
-      && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type)))
-    return true;
-
   /* If the array type has an aliased component in the front-end sense,
      then it also has an aliased component in the back-end sense.  */
   if (Has_Aliased_Components (gnat_type))
@@ -6357,15 +6351,17 @@ array_type_has_nonaliased_component (tree gnu_type, Entity_Id gnat_type)
   if (Is_Derived_Type (gnat_type))
     {
       tree gnu_parent_type = gnat_to_gnu_type (Etype (gnat_type));
-      int index;
       if (TREE_CODE (gnu_parent_type) == UNCONSTRAINED_ARRAY_TYPE)
 	gnu_parent_type
 	  = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_parent_type))));
-      for (index = Number_Dimensions (gnat_type) - 1; index > 0; index--)
-	gnu_parent_type = TREE_TYPE (gnu_parent_type);
       return TYPE_NONALIASED_COMPONENT (gnu_parent_type);
     }
 
+  /* For a multi-dimensional array type, find the component type.  */
+  while (TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE
+	 && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type)))
+    gnu_type = TREE_TYPE (gnu_type);
+
   /* Otherwise, rely exclusively on properties of the element type.  */
   return type_for_nonaliased_component_p (TREE_TYPE (gnu_type));
 }
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ac19a5ebc684..910265293436 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-01-27  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/opt75.adb: New test.
+	* gnat.dg/opt75_pkg.ad[sb]: New helper.
+
 2019-01-27  Uroš Bizjak  <ubizjak@gmail.com>
 
 	PR target/88948
diff --git a/gcc/testsuite/gnat.dg/opt75.adb b/gcc/testsuite/gnat.dg/opt75.adb
new file mode 100644
index 000000000000..080a5183f235
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt75.adb
@@ -0,0 +1,9 @@
+-- { dg-do run }
+-- { dg-options "-O3" }
+
+with Opt75_Pkg; use Opt75_Pkg;
+
+procedure Opt75 is
+begin
+  null;
+end;
diff --git a/gcc/testsuite/gnat.dg/opt75_pkg.adb b/gcc/testsuite/gnat.dg/opt75_pkg.adb
new file mode 100644
index 000000000000..4424e70ec8d4
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt75_pkg.adb
@@ -0,0 +1,12 @@
+package body Opt75_Pkg is
+
+  overriding procedure Adjust (Object : in out T) is
+  begin
+    if Object.Ref /= Empty_Rec'Access then
+      System.Atomic_Counters.Increment (Object.Ref.Counter);
+    end if;
+  end;
+
+  A : constant Arr := (others => (others => Empty));
+
+end Opt75_Pkg;
diff --git a/gcc/testsuite/gnat.dg/opt75_pkg.ads b/gcc/testsuite/gnat.dg/opt75_pkg.ads
new file mode 100644
index 000000000000..4fae165e77f7
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/opt75_pkg.ads
@@ -0,0 +1,27 @@
+pragma Restrictions (No_Abort_Statements);
+pragma Restrictions (Max_Asynchronous_Select_Nesting => 0);
+
+with Ada.Finalization;
+with System.Atomic_Counters;
+
+package Opt75_Pkg is
+
+  type Rec is record
+    Counter : System.Atomic_Counters.Atomic_Counter;
+  end record;
+
+  type Rec_Ptr is access all Rec;
+
+  Empty_Rec : aliased Rec;
+
+  type T is new Ada.Finalization.Controlled with record
+    Ref : Rec_Ptr := Empty_Rec'Access;
+  end record;
+
+  overriding procedure Adjust (Object : in out T);
+
+  Empty : constant T := (Ada.Finalization.Controlled with Ref => Empty_Rec'Access);
+
+  type Arr is array (Integer range 1 .. 8, Integer range 1 .. 4) of T;
+
+end Opt75_Pkg;