From 43b60e578393cc58f1d75387b811cc90bc74297b Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 11 Oct 2019 08:33:03 +0000 Subject: [PATCH] decl.c (Gigi_Equivalent_Type): New case. * gcc-interface/decl.c (Gigi_Equivalent_Type) : New case. Return the base type if the subtype is not constrained. From-SVN: r276865 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/gcc-interface/decl.c | 5 +++++ gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/array38.adb | 11 +++++++++++ gcc/testsuite/gnat.dg/array38_pkg.adb | 8 ++++++++ gcc/testsuite/gnat.dg/array38_pkg.ads | 18 ++++++++++++++++++ 6 files changed, 52 insertions(+) create mode 100644 gcc/testsuite/gnat.dg/array38.adb create mode 100644 gcc/testsuite/gnat.dg/array38_pkg.adb create mode 100644 gcc/testsuite/gnat.dg/array38_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 896efda0e88..8e11108c4fc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-10-11 Eric Botcazou + + * gcc-interface/decl.c (Gigi_Equivalent_Type) : New + case. Return the base type if the subtype is not constrained. + 2019-10-11 Eric Botcazou * gcc-interface/decl.c (gnat_to_gnu_entity) : diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 4878f5e3f9f..25298241eba 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -5026,6 +5026,11 @@ Gigi_Equivalent_Type (Entity_Id gnat_entity) gnat_equiv = Etype (gnat_entity); break; + case E_Array_Subtype: + if (!Is_Constrained (gnat_entity)) + gnat_equiv = Etype (gnat_entity); + break; + case E_Class_Wide_Type: gnat_equiv = Root_Type (gnat_entity); break; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0f55eecfff4..612b22b9243 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-10-11 Eric Botcazou + + * gnat.dg/array38.adb: New test. + * gnat.dg/array38_pkg.ad[sb]: New helper. + 2019-10-11 Jakub Jelinek PR c++/91987 diff --git a/gcc/testsuite/gnat.dg/array38.adb b/gcc/testsuite/gnat.dg/array38.adb new file mode 100644 index 00000000000..fe37b653eaa --- /dev/null +++ b/gcc/testsuite/gnat.dg/array38.adb @@ -0,0 +1,11 @@ +-- { dg-do compile } + +with Array38_Pkg; use Array38_Pkg; + +procedure Array38 is + + function My_F is new F (Index, Byte, Bytes, Integer); + +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/array38_pkg.adb b/gcc/testsuite/gnat.dg/array38_pkg.adb new file mode 100644 index 00000000000..ebaa66eba8e --- /dev/null +++ b/gcc/testsuite/gnat.dg/array38_pkg.adb @@ -0,0 +1,8 @@ +package body Array38_Pkg is + + function F (Data : Array_Type) return Value_Type is + begin + return Value_Type'First; + end; + +end Array38_Pkg; diff --git a/gcc/testsuite/gnat.dg/array38_pkg.ads b/gcc/testsuite/gnat.dg/array38_pkg.ads new file mode 100644 index 00000000000..17c3ef47892 --- /dev/null +++ b/gcc/testsuite/gnat.dg/array38_pkg.ads @@ -0,0 +1,18 @@ +package Array38_Pkg is + + type Byte is mod 2**8; + + type Length is new Natural; + subtype Index is Length range 1 .. Length'Last; + + type Bytes is array (Index range <>) of Byte with + Predicate => Bytes'Length > 0; + + generic + type Index_Type is (<>); + type Element_Type is (<>); + type Array_Type is array (Index_Type range <>) of Element_Type; + type Value_Type is (<>); + function F (Data : Array_Type) return Value_Type; + +end Array38_Pkg; -- 2.30.2