aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2019-08-21 08:29:42 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-08-21 08:29:42 +0000
commit78170c8ea108d76c9ed44b9a59546aadf64e9c3e (patch)
treef25d401dba115fe9f6b26cabfeeb69200890ed7b
parent5188952e59475e3744c88aba9d9e8b07c8364987 (diff)
downloadgcc-78170c8ea108d76c9ed44b9a59546aadf64e9c3e.zip
gcc-78170c8ea108d76c9ed44b9a59546aadf64e9c3e.tar.gz
gcc-78170c8ea108d76c9ed44b9a59546aadf64e9c3e.tar.bz2
[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. From-SVN: r274778
-rw-r--r--gcc/ada/ChangeLog5
-rw-r--r--gcc/ada/exp_util.adb9
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gnat.dg/prot9.adb10
-rw-r--r--gcc/testsuite/gnat.dg/prot9_gen.ads9
-rw-r--r--gcc/testsuite/gnat.dg/prot9_pkg1.ads11
-rw-r--r--gcc/testsuite/gnat.dg/prot9_pkg2.ads16
7 files changed, 61 insertions, 4 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fc1eb94..f9dcd0c 100644
--- 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 d3f648f..c3c5e79 100644
--- 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 50929c1..0826d14 100644
--- 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
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
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
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
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;