An access discriminant has an anonymous access type whose scope is the
enclosing package. If a derived type inherits access discriminants, their
itypes needs to be referenced in the current scope before the bodies of
primitive operations for the derived type are elaborated, to ensure that the
first reference to those itypes appears in the proper scope.
The package b,adb must compile quietly.
---
package A is
type T1 (<>) is tagged limited private;
function T1_Ctor return T1;
private
type T1 (I_Ptr : access Integer) is tagged limited null record;
end A;
---
package body A is
function T1_Ctor return T1 is
begin
return (I_Ptr => null);
end T1_Ctor;
end A;
---
with A;
package B is
type T2 (<>) is new A.T1 with private;
function T2_Ctor return T2;
private
type T2 is new A.T1 with null record;
end B;
---
package body B is
function T2_Ctor return T2 is
begin
return T2'(A.T1_Ctor with null record);
end T2_Ctor;
end B;
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-10-31 Ed Schonberg <schonb...@adacore.com>
* sem_ch3.adb (Build_Derived_Private_Type): If the derived
type has access discriminants, create itype references for their
anonymous types, so that they are elaborated before the generated
bodies for the primitive operations of the type.
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 216925)
+++ sem_ch3.adb (working copy)
@@ -6943,6 +6943,28 @@
Set_Is_Frozen (Full_Der);
+ -- If the derived type has access discriminants, create
+ -- references to their anonymous types now, to prevent
+ -- back-end problems when their first use is in generated
+ -- bodies of primitives.
+
+ declare
+ E : Entity_Id;
+
+ begin
+ E := First_Entity (Full_Der);
+
+ while Present (E) loop
+ if Ekind (E) = E_Discriminant
+ and then Ekind (Etype (E)) = E_Anonymous_Access_Type
+ then
+ Build_Itype_Reference (Etype (E), Decl);
+ end if;
+
+ Next_Entity (E);
+ end loop;
+ end;
+
-- Set up links between real entity and underlying record view
Set_Underlying_Record_View (Derived_Type, Base_Type (Full_Der));
