[gcc r11-1889] [Ada] Errors in handling of access_to_subprogram contracts

[gcc r11-1889] [Ada] Errors in handling of access_to_subprogram contracts

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:9b501e59d1d5c2aa28574fd188db04f7e762f4cd

commit r11-1889-g9b501e59d1d5c2aa28574fd188db04f7e762f4cd
Author: Ed Schonberg <schonberg@adacore.com>
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),