===================================================================
@@ -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);
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.