Patchwork [Ada] Error on conversion of access to incomplete type implementing interface

login
register
mail settings
Submitter Arnaud Charlet
Date June 22, 2010, 7:18 a.m.
Message ID <20100622071814.GA14285@adacore.com>
Download mbox | patch
Permalink /patch/56404/
State New
Headers show

Comments

Arnaud Charlet - June 22, 2010, 7:18 a.m.
The compiler gives an error about a wrong interface conversion when
the conversion operand is of an access type designating an incomplete
type even though the full type implements the interface designated by
the target type (or fails with a bug box for a compiler with assertions
enabled). The compiler failed to retrieve the full type of the designated
type, which is corrected here.

The following package must compile quietly:

package Incomp_Interface_Bug is

  type Intface;
  type Acc_Intface is access all Intface'Class;
  type Intface is interface;

  type Implementor;
  type Acc_Implementor is access all Implementor;

  type Implementor is new Intface with record
     I : Integer;
  end record;

  procedure Pass_Intface (AIF : Acc_Intface);
  procedure Initialize (Impl_Acc : in out Acc_Implementor);

end Incomp_Interface_Bug;

package body Incomp_Interface_Bug is

  procedure Pass_Intface (AIF : Acc_Intface) is
  begin
     null;
  end Pass_Intface;

  procedure Initialize (Impl_Acc : in out Acc_Implementor) is
  begin
     Pass_Intface (Acc_Intface (Impl_Acc));
  end Initialize;

end Incomp_Interface_Bug;

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

2010-06-22  Gary Dismukes  <dismukes@adacore.com>

	* exp_util.adb (Find_Interface_ADT): Retrieve Designated_Type instead of
	Directly_Designated_Type when the type argument is an access type.
	(Find_Interface_Tag): Retrieve Designated_Type instead of
	Directly_Designated_Type when the type argument is an access type.
	(Has_Controlled_Coextensions): Retrieve Designated_Type instead of
	Directly_Designated_Type of each access discriminant.
	* sem_res.adb (Resolve_Type_Conversion): Retrieve Designated_Type
	instead of Directly_Designated_Type when the operand and target types
	are access types.

Patch

Index: exp_util.adb
===================================================================
--- exp_util.adb	(revision 161136)
+++ exp_util.adb	(working copy)
@@ -1487,7 +1487,7 @@  package body Exp_Util is
       --  Handle access types
 
       if Is_Access_Type (Typ) then
-         Typ := Directly_Designated_Type (Typ);
+         Typ := Designated_Type (Typ);
       end if;
 
       --  Handle task and protected types implementing interfaces
@@ -1594,7 +1594,7 @@  package body Exp_Util is
       --  Handle access types
 
       if Is_Access_Type (Typ) then
-         Typ := Directly_Designated_Type (Typ);
+         Typ := Designated_Type (Typ);
       end if;
 
       --  Handle class-wide types
@@ -2129,9 +2129,9 @@  package body Exp_Util is
 
             if Ekind (D_Typ) = E_Anonymous_Access_Type
               and then
-                (Is_Controlled (Directly_Designated_Type (D_Typ))
+                (Is_Controlled (Designated_Type (D_Typ))
                    or else
-                 Is_Concurrent_Type (Directly_Designated_Type (D_Typ)))
+                 Is_Concurrent_Type (Designated_Type (D_Typ)))
             then
                return True;
             end if;
Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 161136)
+++ sem_res.adb	(working copy)
@@ -218,7 +218,7 @@  package body Sem_Res is
    --  A call to a user-defined intrinsic operator is rewritten as a call
    --  to the corresponding predefined operator, with suitable conversions.
    --  Note that this applies only for intrinsic operators that denote
-   --  predefined operators, not opeartors that are intrinsic imports of
+   --  predefined operators, not operators that are intrinsic imports of
    --  back-end builtins.
 
    procedure Resolve_Intrinsic_Unary_Operator (N : Node_Id; Typ : Entity_Id);
@@ -4625,7 +4625,7 @@  package body Sem_Res is
 
          --  If the context is Universal_Fixed and the operands are also
          --  universal fixed, this is an error, unless there is only one
-         --  applicable fixed_point type (usually duration).
+         --  applicable fixed_point type (usually Duration).
 
          if B_Typ = Universal_Fixed and then Etype (L) = Universal_Fixed then
             T := Unique_Fixed_Point_Type (N);
@@ -8608,11 +8608,11 @@  package body Sem_Res is
 
          begin
             if Is_Access_Type (Opnd) then
-               Opnd := Directly_Designated_Type (Opnd);
+               Opnd := Designated_Type (Opnd);
             end if;
 
             if Is_Access_Type (Target_Typ) then
-               Target := Directly_Designated_Type (Target);
+               Target := Designated_Type (Target);
             end if;
 
             if Opnd = Target then