diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6e71b2505ce..4a147775625 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-01-27 Eric Botcazou + + * 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 * gcc-interface/trans.c (Regular_Loop_to_gnu): Use the SLOC of the diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 4a2f6a6177a..a1cd6949a9d 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -6237,12 +6237,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)) @@ -6253,15 +6247,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); + /* Consider that an array of pointers has an aliased component, which is sort of logical and helps with Taft Amendment types in LTO mode. */ if (POINTER_TYPE_P (TREE_TYPE (gnu_type))) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9df3ce670aa..e4d6a1ed436 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-01-27 Eric Botcazou + + * gnat.dg/opt75.adb: New test. + * gnat.dg/opt75_pkg.ad[sb]: New helper. + 2019-01-27 Jakub Jelinek PR target/87214 diff --git a/gcc/testsuite/gnat.dg/opt75.adb b/gcc/testsuite/gnat.dg/opt75.adb new file mode 100644 index 00000000000..080a5183f23 --- /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 00000000000..4424e70ec8d --- /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 00000000000..4fae165e77f --- /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;