diff mbox

[Ada] The type of an in-out formal in a child instance

Message ID 20101007135949.GA15435@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Oct. 7, 2010, 1:59 p.m. UTC 
In most cases the type of an in-out formal is itself a formal type, and in
an instantiation it is obtained with the Get_Instance mapping. In other cases
it comes from the enclosing environment and is established when compiling the
generic. If the unit is a child unit, the type may also be declared in a parent
unit without being a generic type, in which case it has to be retrieved by
normal visibility, once the parent instances have been installed.

The following must compile quietly:

---
with g1;
with g1.g2;
procedure main is
   package p is new g1;

   av : p.t;
   package c is new p.g2 (av);
begin
  null;
end main;
---
generic
package g1 is
  type t is (hi);
end g1;
---
generic
  fv : in out t;  
package g1.g2 is
end g1.g2;

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-10-07  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.ad: (Instantiate_Object): For an in-out formal of a child
	unit, if the type of the formal is declared in a parent unit and is not
	a formal itself, the actual must be located from an enclosing parent
	instance by normal visibility.
diff mbox

Patch

Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb	(revision 165106)
+++ sem_ch12.adb	(working copy)
@@ -8329,6 +8329,25 @@ 
          Ftyp :=
            Get_Instance_Of (Etype (Defining_Identifier (Analyzed_Formal)));
 
+         --  If the type of the formal is not itself a formal, and the
+         --  current unit is a child unit, the formal type must be declared
+         --  in a parent, and must be retrieved by visibility.
+
+         if Ftyp = Orig_Ftyp
+           and then Is_Generic_Unit (Scope (Ftyp))
+           and then
+             Is_Child_Unit (Scope (Defining_Identifier (Analyzed_Formal)))
+         then
+            declare
+               Temp : constant Node_Id :=
+                 New_Copy_Tree (Subtype_Mark (Analyzed_Formal));
+            begin
+               Set_Entity (Temp, Empty);
+               Find_Type (Temp);
+               Ftyp := Entity (Temp);
+            end;
+         end if;
+
          if Is_Private_Type (Ftyp)
            and then not Is_Private_Type (Etype (Actual))
            and then (Base_Type (Full_View (Ftyp)) = Base_Type (Etype (Actual))