From patchwork Mon Jun 14 12:40:20 2010
Content-Type: text/plain; charset="utf-8"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Subject: [Ada] Use_Type and operators that are primitive in more than one type
Date: Mon, 14 Jun 2010 02:40:20 -0000
From: Arnaud Charlet <charlet@adacore.com>
X-Patchwork-Id: 55523
Message-Id: <20100614124020.GA10532@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Ed Schonberg <schonberg@adacore.com>

An operator may be a primitive operation of more than one untagged type. When
exiting the scope of a use_type clause, we must examine the use-visibility of
all formal types before resetting the visbility of the operator itself.

The following must compile quietly:

with Types;
package Ops is
  use type Types.Long_T;
  procedure Mult_G;
end Ops;

---
package body Ops is
   function Log (From : in Types.Long_64_T) return Integer is
      use type Types.Long_64_T;
   begin
      return 1;
   end Log;

   procedure Mult_G is
      Res1 : Types.Long_64_T;
      X    : Types.Long_T;
      Res2 : Types.Long_64_T := Res1 / X;
   begin
      null;
   end Mult_G;
end Ops;
---
package Types is
   type Long_T is range -(2**31) .. (2**31) - 1;
   type Long_64_T is new Long_Long_Integer;

   function "/" (Left  : Long_64_T; Right : Long_T) return Long_64_T;
end Types;

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

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

	* sem_ch8.adb (End_Use_Type): Before indicating that an operator is not
	use-visible, check whether it is a primitive for more than one type.

Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb	(revision 160728)
+++ sem_ch8.adb	(working copy)
@@ -3426,33 +3426,47 @@ package body Sem_Ch8 is
    ------------------
 
    procedure End_Use_Type (N : Node_Id) is
+      Elmt    : Elmt_Id;
       Id      : Entity_Id;
       Op_List : Elist_Id;
-      Elmt    : Elmt_Id;
+      Op      : Entity_Id;
       T       : Entity_Id;
 
+      function May_Be_Used_Primitive_Of (T : Entity_Id) return Boolean;
+      --  An operator may be primitive in several types, if they are declared
+      --  in the same scope as the operator. To determine the use-visiblity of
+      --  the operator in such cases we must examine all types in the profile.
+
+      ------------------------------
+      -- May_Be_Used_Primitive_Of --
+      ------------------------------
+
+      function May_Be_Used_Primitive_Of (T : Entity_Id) return Boolean is
+      begin
+         return Scope (Op) = Scope (T)
+           and then (In_Use (T) or else Is_Potentially_Use_Visible (T));
+      end May_Be_Used_Primitive_Of;
+
+   --  Start of processing for End_Use_Type
+
    begin
       Id := First (Subtype_Marks (N));
       while Present (Id) loop
 
-         --  A call to rtsfind may occur while analyzing a use_type clause,
+         --  A call to Rtsfind may occur while analyzing a use_type clause,
          --  in which case the type marks are not resolved yet, and there is
          --  nothing to remove.
 
-         if not Is_Entity_Name (Id)
-           or else No (Entity (Id))
-         then
+         if not Is_Entity_Name (Id) or else No (Entity (Id)) then
             goto Continue;
          end if;
 
          T := Entity (Id);
 
-         if T = Any_Type
-           or else From_With_Type (T)
-         then
+         if T = Any_Type or else From_With_Type (T) then
             null;
 
-         --  Note that the use_Type clause may mention a subtype of the type
+         --  Note that the use_type clause may mention a subtype of the type
          --  whose primitive operations have been made visible. Here as
          --  elsewhere, it is the base type that matters for visibility.
 
@@ -3468,8 +3482,30 @@ package body Sem_Ch8 is
 
             Elmt := First_Elmt (Op_List);
             while Present (Elmt) loop
-               if Nkind (Node (Elmt)) = N_Defining_Operator_Symbol then
-                  Set_Is_Potentially_Use_Visible (Node (Elmt), False);
+               Op := Node (Elmt);
+
+               if Nkind (Op) = N_Defining_Operator_Symbol then
+                  declare
+                     T_First : constant Entity_Id :=
+                                 Base_Type (Etype (First_Formal (Op)));
+                     T_Res   : constant Entity_Id := Base_Type (Etype (Op));
+                     T_Next  : Entity_Id;
+
+                  begin
+                     if Present (Next_Formal (First_Formal (Op))) then
+                        T_Next :=
+                          Base_Type (Etype (Next_Formal (First_Formal (Op))));
+                     else
+                        T_Next := T_First;
+                     end if;
+
+                     if not May_Be_Used_Primitive_Of (T_First)
+                       and then not May_Be_Used_Primitive_Of (T_Next)
+                       and then not May_Be_Used_Primitive_Of (T_Res)
+                     then
+                        Set_Is_Potentially_Use_Visible (Op, False);
+                     end if;
+                  end;
                end if;
 
                Next_Elmt (Elmt);