@@ -2976,10 +2976,7 @@ package body Sem_Ch4 is
procedure Find_Interpretation;
function Find_Interpretation return Boolean;
- -- Routine and wrapper to find a matching interpretation in case
- -- of overloading. The wrapper returns True iff a matching
- -- interpretation is found. Beware, in absence of overloading,
- -- using this function will break gnat's bootstrapping.
+ -- Routine and wrapper to find a matching interpretation
procedure Try_One_Interp (T1 : Entity_Id);
-- Routine to try one proposed interpretation. Note that the context
@@ -3091,11 +3088,16 @@ package body Sem_Ch4 is
procedure Find_Interpretation is
begin
- Get_First_Interp (L, Index, It);
- while Present (It.Typ) loop
- Try_One_Interp (It.Typ);
- Get_Next_Interp (Index, It);
- end loop;
+ if not Is_Overloaded (L) then
+ Try_One_Interp (Etype (L));
+
+ else
+ Get_First_Interp (L, Index, It);
+ while Present (It.Typ) loop
+ Try_One_Interp (It.Typ);
+ Get_Next_Interp (Index, It);
+ end loop;
+ end if;
end Find_Interpretation;
function Find_Interpretation return Boolean is
@@ -3111,7 +3113,7 @@ package body Sem_Ch4 is
procedure Try_One_Interp (T1 : Entity_Id) is
begin
- if Has_Compatible_Type (R, T1) then
+ if Has_Compatible_Type (R, T1) or else Covers (Etype (R), T1) then
if Found
and then Base_Type (T1) /= Base_Type (T_F)
then
@@ -3156,12 +3158,7 @@ package body Sem_Ch4 is
then
Analyze (R);
- if not Is_Overloaded (L) then
- Try_One_Interp (Etype (L));
-
- else
- Find_Interpretation;
- end if;
+ Find_Interpretation;
-- If not a range, it can be a subtype mark, or else it is a degenerate
-- membership test with a singleton value, i.e. a test for equality,
@@ -3170,16 +3167,11 @@ package body Sem_Ch4 is
else
Analyze (R);
- if Is_Entity_Name (R)
- and then Is_Type (Entity (R))
- then
+ if Is_Entity_Name (R) and then Is_Type (Entity (R)) then
Find_Type (R);
Check_Fully_Declared (Entity (R), R);
- elsif Ada_Version >= Ada_2012 and then
- ((Is_Overloaded (L) and then Find_Interpretation) or else
- (not Is_Overloaded (L) and then Has_Compatible_Type (R, Etype (L))))
- then
+ elsif Ada_Version >= Ada_2012 and then Find_Interpretation then
if Nkind (N) = N_In then
Op := Make_Op_Eq (Loc, Left_Opnd => L, Right_Opnd => R);
else
@@ -5918,14 +5910,16 @@ package body Sem_Ch4 is
begin
-- Verify that Op_Id is a visible binary function. Note that since
-- we know Op_Id is overloaded, potentially use visible means use
- -- visible for sure (RM 9.4(11)).
+ -- visible for sure (RM 9.4(11)). Be prepared for previous errors.
if Ekind (Op_Id) = E_Function
and then Present (F2)
and then (Is_Immediately_Visible (Op_Id)
or else Is_Potentially_Use_Visible (Op_Id))
- and then Has_Compatible_Type (Left_Opnd (N), Etype (F1))
- and then Has_Compatible_Type (Right_Opnd (N), Etype (F2))
+ and then (Has_Compatible_Type (Left_Opnd (N), Etype (F1))
+ or else Etype (F1) = Any_Type)
+ and then (Has_Compatible_Type (Right_Opnd (N), Etype (F2))
+ or else Etype (F2) = Any_Type)
then
Add_One_Interp (N, Op_Id, Etype (Op_Id));
@@ -6612,7 +6606,10 @@ package body Sem_Ch4 is
return;
end if;
- if Valid_Comparison_Arg (T1) and then Has_Compatible_Type (R, T1) then
+ if Valid_Comparison_Arg (T1)
+ and then (Has_Compatible_Type (R, T1)
+ or else Covers (Etype (R), T1))
+ then
if Found and then Base_Type (T1) /= Base_Type (T_F) then
It := Disambiguate (L, I_F, Index, Any_Type);
@@ -6710,6 +6707,7 @@ package body Sem_Ch4 is
Get_Next_Interp (Index, It);
end loop;
end if;
+
elsif Has_Compatible_Type (R, T1) or else Covers (Etype (R), T1) then
Add_One_Interp (N, Op_Id, Standard_Boolean, Base_Type (T1));
end if;
@@ -7100,7 +7098,9 @@ package body Sem_Ch4 is
-- Finally, also check for RM 4.5.2 (9.6/2).
if T1 /= Standard_Void_Type
- and then (Universal_Access or else Has_Compatible_Type (R, T1))
+ and then (Universal_Access
+ or else Has_Compatible_Type (R, T1)
+ or else Covers (Etype (R), T1))
and then
((not Is_Limited_Type (T1)
@@ -7161,9 +7161,7 @@ package body Sem_Ch4 is
-- If left operand is aggregate, the right operand has to
-- provide a usable type for it.
- if Nkind (L) = N_Aggregate
- and then Nkind (R) /= N_Aggregate
- then
+ if Nkind (L) = N_Aggregate and then Nkind (R) /= N_Aggregate then
Find_Equality_Types (L => R, R => L, Op_Id => Op_Id, N => N);
return;
end if;
@@ -2449,11 +2449,8 @@ package body Sem_Type is
return False;
end if;
- if Nkind (N) = N_Subtype_Indication
- or else not Is_Overloaded (N)
- then
- return
- Covers (Typ, Etype (N))
+ if Nkind (N) = N_Subtype_Indication or else not Is_Overloaded (N) then
+ if Covers (Typ, Etype (N))
-- Ada 2005 (AI-345): The context may be a synchronized interface.
-- If the type is already frozen use the corresponding_record
@@ -2471,11 +2468,6 @@ package body Sem_Type is
and then Present (Corresponding_Record_Type (Typ))
and then Covers (Corresponding_Record_Type (Typ), Etype (N)))
- or else
- (not Is_Tagged_Type (Typ)
- and then Ekind (Typ) /= E_Anonymous_Access_Type
- and then Covers (Etype (N), Typ))
-
or else
(Nkind (N) = N_Integer_Literal
and then Present (Find_Aspect (Typ, Aspect_Integer_Literal)))
@@ -2486,7 +2478,10 @@ package body Sem_Type is
or else
(Nkind (N) = N_String_Literal
- and then Present (Find_Aspect (Typ, Aspect_String_Literal)));
+ and then Present (Find_Aspect (Typ, Aspect_String_Literal)))
+ then
+ return True;
+ end if;
-- Overloaded case
@@ -2501,24 +2496,22 @@ package body Sem_Type is
-- Ada 2005 (AI-345)
or else
- (Is_Concurrent_Type (It.Typ)
+ (Is_Record_Type (Typ)
+ and then Is_Concurrent_Type (It.Typ)
and then Present (Corresponding_Record_Type
(Etype (It.Typ)))
and then Covers (Typ, Corresponding_Record_Type
(Etype (It.Typ))))
- or else (not Is_Tagged_Type (Typ)
- and then Ekind (Typ) /= E_Anonymous_Access_Type
- and then Covers (It.Typ, Typ))
then
return True;
end if;
Get_Next_Interp (I, It);
end loop;
-
- return False;
end if;
+
+ return False;
end Has_Compatible_Type;
---------------------