Patchwork [Ada] Interface operations with access formal in constrained extension

login
register
mail settings
Submitter Arnaud Charlet
Date June 17, 2010, 12:26 p.m.
Message ID <20100617122654.GA9182@adacore.com>
Download mbox | patch
Permalink /patch/56030/
State New
Headers show

Comments

Arnaud Charlet - June 17, 2010, 12:26 p.m.
If the parent type in a type extension is a discriminated type with constraints,
the compiler creates an anonymous base type for it, and makes the source type
into a subtype of this base. If an overridden operation of a  progenitor of the
type extension has an access parameter, the interface thunk for the overriding
operation must use this anonymous base type in the constructed call to the
overriding subprogram, to avois spurious type errors.

The following must compile and execute quietly:
---
package Ref is
   type I is interface;
   procedure P (V : access I) is abstract;

   type C is record
      V : access I'Class;
   end record;

   type Root (V : Integer) is tagged null record;
   type Child is new Root (1) with null record;
   type Grand_Child is new Child and I with record
      null;
   end record;

   procedure P (V : access Grand_Child);
end Ref;
---
package body Ref is
   procedure P (V : access Grand_Child) is begin null; end;
end Ref;

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

2010-06-17  Ed Schonberg  <schonberg@adacore.com>

	* exp_disp.adb (Build_Interface_Thunk): Use base type of formal to
	determine whether it has the controlling type, when the formal is an
	access parameter.

Patch

Index: exp_disp.adb
===================================================================
--- exp_disp.adb	(revision 160895)
+++ exp_disp.adb	(working copy)
@@ -1533,20 +1533,22 @@  package body Exp_Disp is
       Formal        := First (Formals);
       while Present (Formal) loop
 
-         --  Handle concurrent types
+         --  If the parent is a constrained discriminated type, then the
+         --  primitive operation will have been defined on a first subtype.
+         --  For proper matching with controlling type, use base type.
 
          if Ekind (Target_Formal) = E_In_Parameter
            and then Ekind (Etype (Target_Formal)) = E_Anonymous_Access_Type
          then
-            Ftyp := Directly_Designated_Type (Etype (Target_Formal));
+            Ftyp :=
+              Base_Type (Directly_Designated_Type (Etype (Target_Formal)));
          else
-            --  If the parent is a constrained discriminated type, then the
-            --  primitive operation will have been defined on a first subtype.
-            --  For proper matching with controlling type, use base type.
-
             Ftyp := Base_Type (Etype (Target_Formal));
          end if;
 
+         --  For concurrent types, the relevant info is on the corresponding_
+         --  record type.
+
          if Is_Concurrent_Type (Ftyp) then
             Ftyp := Corresponding_Record_Type (Ftyp);
          end if;