diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2019-08-21 08:29:42 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-08-21 08:29:42 +0000 |
commit | 78170c8ea108d76c9ed44b9a59546aadf64e9c3e (patch) | |
tree | f25d401dba115fe9f6b26cabfeeb69200890ed7b | |
parent | 5188952e59475e3744c88aba9d9e8b07c8364987 (diff) | |
download | gcc-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/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/ada/exp_util.adb | 9 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/prot9.adb | 10 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/prot9_gen.ads | 9 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/prot9_pkg1.ads | 11 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/prot9_pkg2.ads | 16 |
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; |