This fixes an assertion failure on the instantiation of a generic
package on a type derived from the private view of a protected type,
ultimately caused by Finalize_Address returning Empty for the subtype
built for the generic actual type of the instantiation.
Finalize_Address has a special processing for untagged derivations of
private views, but it would no longer trigger for the subtype because
this subtype is now represented as a subtype of an implicit derived base
type instead of as the derived type of an implicit subtype previously.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-08-21 Eric Botcazou <ebotca...@adacore.com>
gcc/ada/
* exp_util.adb (Finalize_Address): Deal consistently with
subtypes of private protected types.
gcc/testsuite/
* gnat.dg/prot9.adb, gnat.dg/prot9_gen.ads,
gnat.dg/prot9_pkg1.ads, gnat.dg/prot9_pkg2.ads: New testcase.--- gcc/ada/exp_util.adb
+++ gcc/ada/exp_util.adb
@@ -5347,6 +5347,7 @@ package body Exp_Util is
----------------------
function Finalize_Address (Typ : Entity_Id) return Entity_Id is
+ Btyp : constant Entity_Id := Base_Type (Typ);
Utyp : Entity_Id := Typ;
begin
@@ -5386,12 +5387,12 @@ package body Exp_Util is
-- records do not automatically inherit operations, but maybe they
-- should???)
- if Is_Untagged_Derivation (Typ) then
- if Is_Protected_Type (Typ) then
- Utyp := Corresponding_Record_Type (Root_Type (Base_Type (Typ)));
+ if Is_Untagged_Derivation (Btyp) then
+ if Is_Protected_Type (Btyp) then
+ Utyp := Corresponding_Record_Type (Root_Type (Btyp));
else
- Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
+ Utyp := Underlying_Type (Root_Type (Btyp));
if Is_Protected_Type (Utyp) then
Utyp := Corresponding_Record_Type (Utyp);
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/prot9.adb
@@ -0,0 +1,10 @@
+-- { dg-do compile }
+
+with Prot9_Gen;
+with Prot9_Pkg1;
+
+procedure Prot9 is
+ package Dummy is new Prot9_Gen (Prot9_Pkg1.Prot_Type);
+begin
+ null;
+end Prot9;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/prot9_gen.ads
@@ -0,0 +1,9 @@
+generic
+ type Field_Type is limited private;
+package Prot9_Gen is
+
+ type Field_Pointer is access all Field_Type;
+
+ Pointer : Field_Pointer := new Field_Type;
+
+end Prot9_Gen;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/prot9_pkg1.ads
@@ -0,0 +1,11 @@
+with Prot9_Pkg2;
+
+package Prot9_Pkg1 is
+
+ type Prot_Type is limited private;
+
+private
+
+ type Prot_Type is new Prot9_Pkg2.Prot_Type;
+
+end Prot9_Pkg1;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/prot9_pkg2.ads
@@ -0,0 +1,16 @@
+with Ada.Containers.Doubly_Linked_Lists;
+
+package Prot9_Pkg2 is
+
+ type Prot_type is limited private;
+
+private
+
+ package My_Lists is new Ada.Containers.Doubly_Linked_Lists (Integer);
+
+ protected type Prot_type is
+ private
+ L : My_Lists.List;
+ end Prot_type;
+
+end Prot9_Pkg2;
