[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 --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 7d847329378eedeed99fdf2e5dec5141a1f18d2a..fb23931ae63aa5b5bd7689e9c418e645d68b2212 100644 (file)
--- 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 3ccf0c386c83d878071aba0aeeb9c8b709d1b635..8efada408b4c2f3729fdb9aef2c20a9ebb0f31d3 100644 (file)
--- 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),