Patchwork [Ada] AI05-0020 : universal operators of fixed point and access types

login
register
mail settings
Submitter Arnaud Charlet
Date Aug. 4, 2011, 1:31 p.m.
Message ID <20110804133127.GA7999@adacore.com>
Download mbox | patch
Permalink /patch/108458/
State New
Headers show

Comments

Arnaud Charlet - Aug. 4, 2011, 1:31 p.m.
This AI specifies that a user-defined equality on an anonymous access type
whose designated type is private does not lead to an ambiguity with the
universal access equality operator in the body or child units of the defining
package. The same is true for a multiplication operator on a private type
completed with a fixed-point-type.

The following must compile and execute quietly:

with P;
procedure AI20 is
begin
   null;
end;
---
package body P is
  function Compare (L, R : access T) return Boolean is
  begin
     return L = R;
  end;
  function "=" (L, R : access T) return Boolean is
  begin
     return True;
  end;

  function "*" (L, R : TF) return TF is
  begin
     return L + R;
  end;

  X, Y : access T := new T;
  Val1, Val2 : TF := 3.0;
begin
  if not Compare (X, Y) then raise Program_Error; end if;
  Val1 := Val1 * Val2;
  if Val1 /= 6.0 then
     raise Program_Error;
  end if;
end;
---
package P is
   type T is private;
   function "=" (L, R : access T) return Boolean;

   type TF is private;
   function "*" (L, R : TF) return TF;
private
   type T is null record;
   type TF is delta 1.0 range 0.0..42.0;
end P;

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

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

	* sem_type.adb (Disambiguate): New subsidiary routine
	In_Same_Declaration_List, to implement AI05-0020: a user-defined
	equality on an anonymous access type whose designated type is private
	does not lead to an ambiguity with the universal access equality
	operator in the body or child units of the defining package. The same
	is true for a multiplication operator on a private type completed with
	a fixed-point-type.

Patch

Index: sem_type.adb
===================================================================
--- sem_type.adb	(revision 177344)
+++ sem_type.adb	(working copy)
@@ -1196,6 +1196,17 @@ 
       --  Determine whether one of the candidates is an operation inherited by
       --  a type that is derived from an actual in an instantiation.
 
+      function In_Same_Declaration_List
+        (Typ     : Entity_Id;
+         Op_Decl : Entity_Id) return Boolean;
+      --  AI05-0020: a spurious ambiguity may arise when equality on anonymous
+      --  access types is declared on the partial view of a designated type, so
+      --  that the type declaration and equality are not in the same list of
+      --  declarations. This AI gives a preference rule for the user-defined
+      --  operation. Same rule applies for arithmetic operations on private
+      --  types completed with fixed-point types: the predefined operation is
+      --  hidden;  this is already handled properly in GNAT.
+
       function Is_Actual_Subprogram (S : Entity_Id) return Boolean;
       --  Determine whether a subprogram is an actual in an enclosing instance.
       --  An overloading between such a subprogram and one declared outside the
@@ -1255,6 +1266,26 @@ 
          end if;
       end Inherited_From_Actual;
 
+      ------------------------------
+      -- In_Same_Declaration_List --
+      ------------------------------
+
+      function In_Same_Declaration_List
+        (Typ     : Entity_Id;
+         Op_Decl : Entity_Id) return Boolean
+      is
+         Scop : constant Entity_Id := Scope (Typ);
+
+      begin
+         return In_Same_List (Parent (Typ), Op_Decl)
+           or else
+             (Ekind_In (Scop, E_Package, E_Generic_Package)
+                and then List_Containing (Op_Decl) =
+                  Visible_Declarations (Parent (Scop))
+                and then List_Containing (Parent (Typ)) =
+                  Private_Declarations (Parent (Scop)));
+      end In_Same_Declaration_List;
+
       --------------------------
       -- Is_Actual_Subprogram --
       --------------------------
@@ -1934,8 +1965,9 @@ 
               and then Etype (User_Subp) = Standard_Boolean
               and then Ekind (Operand_Type) = E_Anonymous_Access_Type
               and then
-                In_Same_List (Parent (Designated_Type (Operand_Type)),
-                              Unit_Declaration_Node (User_Subp))
+                In_Same_Declaration_List
+                  (Designated_Type (Operand_Type),
+                     Unit_Declaration_Node (User_Subp))
             then
                if It2.Nam = Predef_Subp then
                   return It1;