From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id B993A3857C79; Tue, 7 Jul 2020 09:29:12 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org B993A3857C79 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1594114152; bh=1IdS3vpUQ2MU1TSQmpjaOpWySfhL8latjbUJOi13eAc=; h=From:To:Subject:Date:From; b=TD8cxN3lV+aByvQlJ/uImNAkLV9GChgtaRTXgHwnhawaBx662fz+XcS684vKeyyIx NENwYRqbPiafK/VDBFHYTiRlPboIJbX4QIe2TuK15LFS8PpTKO6i0NgujYdMvHeVkM 70Hdz0ETtoNIO9nmbSn1H6CfD8BmQYzKl/gl4Qno= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r11-1889] [Ada] Errors in handling of access_to_subprogram contracts X-Act-Checkin: gcc X-Git-Author: Ed Schonberg X-Git-Refname: refs/heads/master X-Git-Oldrev: 7bf53b1a612b1fe08d80d823981879486531ea11 X-Git-Newrev: 9b501e59d1d5c2aa28574fd188db04f7e762f4cd Message-Id: <20200707092912.B993A3857C79@sourceware.org> Date: Tue, 7 Jul 2020 09:29:12 +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, 07 Jul 2020 09:29:12 -0000 https://gcc.gnu.org/g:9b501e59d1d5c2aa28574fd188db04f7e762f4cd commit r11-1889-g9b501e59d1d5c2aa28574fd188db04f7e762f4cd Author: Ed Schonberg Date: Thu May 14 11:06:54 2020 -0400 [Ada] Errors in handling of access_to_subprogram contracts gcc/ada/ * exp_ch3.adb (Build_Access_Subprogram_Wrapper_Body): Create proper subprogram specification for body, using names in the subprogram declaration but distinct entities. * exp_ch6.adb (Expand_Call): If this is an indirect call involving a subprogram wrapper, insert pointer parameter in list of actuals with a parameter association, not as a positional parameter. Diff: --- gcc/ada/exp_ch3.adb | 11 ++++------- gcc/ada/exp_ch6.adb | 22 ++++++++++++++++------ 2 files changed, 20 insertions(+), 13 deletions(-) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 7d847329378..fb23931ae63 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -528,7 +528,8 @@ package body Exp_Ch3 is Type_Def : constant Node_Id := Type_Definition (Decl); Type_Id : constant Entity_Id := Defining_Identifier (Decl); Spec_Node : constant Node_Id := - New_Copy_Tree (Specification (New_Decl)); + Copy_Subprogram_Spec (Specification (New_Decl)); + -- This copy creates new identifiers for formals and subprogram. Act : Node_Id; Body_Node : Node_Id; @@ -540,12 +541,8 @@ package body Exp_Ch3 is return; end if; - Set_Defining_Unit_Name (Spec_Node, - Make_Defining_Identifier - (Loc, Chars (Defining_Unit_Name (Spec_Node)))); - -- Create List of actuals for indirect call. The last parameter of the - -- subprogram is the access value itself. + -- subprogram declaration is the access value for the indirect call. Act := First (Parameter_Specifications (Spec_Node)); @@ -558,7 +555,7 @@ package body Exp_Ch3 is Ptr := Defining_Identifier - (Last (Parameter_Specifications (Spec_Node))); + (Last (Parameter_Specifications (Specification (New_Decl)))); if Nkind (Type_Def) = N_Access_Procedure_Definition then Call_Stmt := Make_Procedure_Call_Statement (Loc, diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 3ccf0c386c8..8efada408b4 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2686,25 +2686,35 @@ package body Exp_Ch6 is Parms : constant List_Id := Parameter_Associations (N); Typ : constant Entity_Id := Etype (N); New_N : Node_Id; + Ptr_Act : Node_Id; begin -- The last actual in the call is the pointer itself. -- If the aspect is inherited, convert the pointer to the -- parent type that specifies the contract. + -- If the original access_to_subprogram has defaults for + -- in_parameters, the call may include named associations, so + -- we create one for the pointer as well. if Is_Derived_Type (Ptr_Type) and then Ptr_Type /= Etype (Last_Formal (Wrapper)) then - Append - (Make_Type_Conversion (Loc, - New_Occurrence_Of - (Etype (Last_Formal (Wrapper)), Loc), Ptr), - Parms); + Ptr_Act := + Make_Type_Conversion (Loc, + New_Occurrence_Of + (Etype (Last_Formal (Wrapper)), Loc), Ptr); else - Append (Ptr, Parms); + Ptr_Act := Ptr; end if; + Append + (Make_Parameter_Association (Loc, + Selector_Name => Make_Identifier (Loc, + Chars (Last_Formal (Wrapper))), + Explicit_Actual_Parameter => Ptr_Act), + Parms); + if Nkind (N) = N_Procedure_Call_Statement then New_N := Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of (Wrapper, Loc),