[Ada] Itype references and generics

Submitted by Arnaud Charlet on Aug. 3, 2011, 8:11 a.m.

Details

Message ID 20110803081118.GA21537@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Aug. 3, 2011, 8:11 a.m.
Itype references are constructed to force the backend to elaborate itypes at
the point of definition, to prevent scope anomalies if the first use of the
itype is within some later nested context. Itypes must not be generated for
formal generic types, and more generally within a generic unit, because the
unit itself is not seen by the backend, and may refer to incomplete types.
The following must compile quietly:

      gcc -c -gnat05 p.adb

---
package body P is
   L: aliased Q.List_Type;

   function Find return access T'Class is
      M : Q.Mark_Type (L'Access);
   begin
      return T((M.Func.all))'Access;
   end Find;
end P;
---
with Q;
package P is
   generic
      type T is tagged private;
   function Find return access T'Class;
end P;
---
package Q is
   type Object is interface;

   type List_Type is tagged null record;

   type Mark_Type (L: access List_Type) is tagged null record;

   function Func (M : Mark_Type) return access Object'Class;
end Q;

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

2011-08-03  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Build_Itype_Reference): do not create an itype reference
	for an itype created within a generic unit.

Patch hide | download patch | download mbox

Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 177237)
+++ sem_ch3.adb	(working copy)
@@ -8631,8 +8631,15 @@ 
    is
       IR : constant Node_Id := Make_Itype_Reference (Sloc (Nod));
    begin
-      Set_Itype (IR, Ityp);
-      Insert_After (Nod, IR);
+
+      --  Itype references are only created for use by the back-end.
+
+      if Inside_A_Generic then
+         return;
+      else
+         Set_Itype (IR, Ityp);
+         Insert_After (Nod, IR);
+      end if;
    end Build_Itype_Reference;
 
    ------------------------