From 9b501e59d1d5c2aa28574fd188db04f7e762f4cd Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 14 May 2020 11:06:54 -0400 Subject: [PATCH] [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. --- 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), -- 2.30.2