From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 80FAA385843E; Tue, 9 Nov 2021 09:47:47 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 80FAA385843E MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-5043] [Ada] Tidy up implementation of Has_Compatible_Type X-Act-Checkin: gcc X-Git-Author: Eric Botcazou X-Git-Refname: refs/heads/master X-Git-Oldrev: a2e4ebe02b1be5ee81b24ff504f58ac9078953c0 X-Git-Newrev: 7df3ac2e9ed53f9320a63f38081561166b140cf2 Message-Id: <20211109094747.80FAA385843E@sourceware.org> Date: Tue, 9 Nov 2021 09:47:47 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 09 Nov 2021 09:47:47 -0000 https://gcc.gnu.org/g:7df3ac2e9ed53f9320a63f38081561166b140cf2 commit r12-5043-g7df3ac2e9ed53f9320a63f38081561166b140cf2 Author: Eric Botcazou Date: Wed Oct 27 23:51:07 2021 +0200 [Ada] Tidy up implementation of Has_Compatible_Type gcc/ada/ * sem_ch4.adb (Analyze_Membership_Op) : Handle both overloaded and non-overloaded cases. : Do a reversed call to Covers if the outcome of the call to Has_Compatible_Type is false. Simplify implementation after change to Find_Interpretation. (Analyze_User_Defined_Binary_Op): Be prepared for previous errors. (Find_Comparison_Types) : Do a reversed call to Covers if the outcome of the call to Has_Compatible_Type is false. (Find_Equality_Types) : Likewise. * sem_type.adb (Has_Compatible_Type): Remove the reversed calls to Covers. Add explicit return on all paths. Diff: --- gcc/ada/sem_ch4.adb | 60 +++++++++++++++++++++++++--------------------------- gcc/ada/sem_type.adb | 27 +++++++++-------------- 2 files changed, 39 insertions(+), 48 deletions(-) diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 22039f5f245..9b1d908097d 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -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; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 8e5b067bb76..923c8f94ee1 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -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; ---------------------