Commit 78170c8e by Eric Botcazou Committed by Pierre-Marie de Rodat

[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
parent 5188952e
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
......
......@@ -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);
......
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:
......
-- { 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;
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;
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;
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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment