[Ada] Fix assertion failure on derived private protected type

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.

2019-08-21  Eric Botcazou  <ebotcazou@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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@274778 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fc1eb946533ef0888602f167a201bdac4ac35579..f9dcd0c72f1adddc364e1ca2166c6943040997e3 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2019-08-21  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * exp_util.adb (Finalize_Address): Deal consistently with
+       subtypes of private protected types.
+
 2019-08-21  Piotr Trojanek  <trojanek@adacore.com>
 
        * exp_util.adb (Corresponding_Runtime_Package): Use high-level

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index d3f648f3dcd46c649bf07462d0f1c15cdffd76a4..c3c5e792d94b4a1257b8c30dab4c3a170aff9fce 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/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);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 50929c173aba67cf51ce2ecdc4fbba4a3dc2b8c1..0826d148040cd8bcfa0664318c473b9283479083 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-08-21  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/prot9.adb, gnat.dg/prot9_gen.ads,
+       gnat.dg/prot9_pkg1.ads, gnat.dg/prot9_pkg2.ads: New testcase.
+
 2019-08-21  Javier Miranda  <miranda@adacore.com>
 
        * gnat.dg/implicit_param.adb, gnat.dg/implicit_param_pkg.ads:

diff --git a/gcc/testsuite/gnat.dg/prot9.adb b/gcc/testsuite/gnat.dg/prot9.adb
new file mode 100644 (file)
index 0000000..6d1a21d
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/prot9_gen.ads b/gcc/testsuite/gnat.dg/prot9_gen.ads
new file mode 100644 (file)
index 0000000..656866e
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/prot9_pkg1.ads b/gcc/testsuite/gnat.dg/prot9_pkg1.ads
new file mode 100644 (file)
index 0000000..5b995bc
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/prot9_pkg2.ads b/gcc/testsuite/gnat.dg/prot9_pkg2.ads
new file mode 100644 (file)
index 0000000..af0e03b
--- /dev/null
+++ b/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;