From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id 87AAB39B4404; Fri, 18 Jun 2021 08:38:04 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 87AAB39B4404 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-1616] [Ada] Code cleanups in exp_ch6.adb X-Act-Checkin: gcc X-Git-Author: Arnaud Charlet X-Git-Refname: refs/heads/master X-Git-Oldrev: 4463d6eebc0a160c93a30feb1a5e8025f9a344d8 X-Git-Newrev: a30647690de250eba61f941bb2a2fd35fe3894fc Message-Id: <20210618083804.87AAB39B4404@sourceware.org> Date: Fri, 18 Jun 2021 08:38:04 +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: Fri, 18 Jun 2021 08:38:04 -0000 https://gcc.gnu.org/g:a30647690de250eba61f941bb2a2fd35fe3894fc commit r12-1616-ga30647690de250eba61f941bb2a2fd35fe3894fc Author: Arnaud Charlet Date: Sun Mar 14 13:32:59 2021 -0400 [Ada] Code cleanups in exp_ch6.adb gcc/ada/ * exp_ch6.adb (Expand_Call_Helper): Code cleanups. Diff: --- gcc/ada/exp_ch6.adb | 105 +++++++++++++++++++++++++--------------------------- 1 file changed, 51 insertions(+), 54 deletions(-) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 6314b0ae7a9..14c5d186eca 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -4248,6 +4248,16 @@ package body Exp_Ch6 is if Nkind (Call_Node) in N_Subprogram_Call and then Present (Controlling_Argument (Call_Node)) then + if Tagged_Type_Expansion then + Expand_Dispatching_Call (Call_Node); + + -- Expand_Dispatching_Call takes care of all the needed processing + + return; + end if; + + -- VM targets + declare Call_Typ : constant Entity_Id := Etype (Call_Node); Typ : constant Entity_Id := Find_Dispatching_Type (Subp); @@ -4257,69 +4267,56 @@ package body Exp_Ch6 is Prev_Call : Node_Id; begin + Apply_Tag_Checks (Call_Node); + if not Is_Limited_Type (Typ) then Eq_Prim_Op := Find_Prim_Op (Typ, Name_Op_Eq); end if; - if Tagged_Type_Expansion then - Expand_Dispatching_Call (Call_Node); - - -- The following return is worrisome. Is it really OK to skip - -- all remaining processing in this procedure ??? - - return; - - -- VM targets - - else - Apply_Tag_Checks (Call_Node); - - -- If this is a dispatching "=", we must first compare the - -- tags so we generate: x.tag = y.tag and then x = y - - if Subp = Eq_Prim_Op then + -- If this is a dispatching "=", we must first compare the + -- tags so we generate: x.tag = y.tag and then x = y - -- Mark the node as analyzed to avoid reanalyzing this - -- dispatching call (which would cause a never-ending loop) - - Prev_Call := Relocate_Node (Call_Node); - Set_Analyzed (Prev_Call); + if Subp = Eq_Prim_Op then - Param := First_Actual (Call_Node); - New_Call := - Make_And_Then (Loc, - Left_Opnd => - Make_Op_Eq (Loc, - Left_Opnd => - Make_Selected_Component (Loc, - Prefix => New_Value (Param), - Selector_Name => - New_Occurrence_Of - (First_Tag_Component (Typ), Loc)), + -- Mark the node as analyzed to avoid reanalyzing this + -- dispatching call (which would cause a never-ending loop) + + Prev_Call := Relocate_Node (Call_Node); + Set_Analyzed (Prev_Call); + + Param := First_Actual (Call_Node); + New_Call := + Make_And_Then (Loc, + Left_Opnd => + Make_Op_Eq (Loc, + Left_Opnd => + Make_Selected_Component (Loc, + Prefix => New_Value (Param), + Selector_Name => + New_Occurrence_Of + (First_Tag_Component (Typ), Loc)), + + Right_Opnd => + Make_Selected_Component (Loc, + Prefix => + Unchecked_Convert_To (Typ, + New_Value (Next_Actual (Param))), + Selector_Name => + New_Occurrence_Of + (First_Tag_Component (Typ), Loc))), + Right_Opnd => Prev_Call); - Right_Opnd => - Make_Selected_Component (Loc, - Prefix => - Unchecked_Convert_To (Typ, - New_Value (Next_Actual (Param))), - Selector_Name => - New_Occurrence_Of - (First_Tag_Component (Typ), Loc))), - Right_Opnd => Prev_Call); - - Rewrite (Call_Node, New_Call); - - Analyze_And_Resolve - (Call_Node, Call_Typ, Suppress => All_Checks); - end if; + Rewrite (Call_Node, New_Call); + Analyze_And_Resolve + (Call_Node, Call_Typ, Suppress => All_Checks); + end if; - -- Expansion of a dispatching call results in an indirect call, - -- which in turn causes current values to be killed (see - -- Resolve_Call), so on VM targets we do the call here to - -- ensure consistent warnings between VM and non-VM targets. + -- Expansion of a dispatching call results in an indirect call, + -- which in turn causes current values to be killed (see + -- Resolve_Call), so on VM targets we do the call here to + -- ensure consistent warnings between VM and non-VM targets. - Kill_Current_Values; - end if; + Kill_Current_Values; -- If this is a dispatching "=" then we must update the reference -- to the call node because we generated: