[Ada] Derived type whose parent has a full view with access discriminants

[Arnaud Charlet]

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  <schonberg@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.

-------------- next part --------------
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));