diff mbox series

[Ada] Errors in handling of access_to_subprogram contracts

Message ID 20200707092736.GA41639@adacore.com
State New
Headers show
Series [Ada] Errors in handling of access_to_subprogram contracts | expand

Commit Message

Pierre-Marie de Rodat July 7, 2020, 9:27 a.m. UTC 
This patch fixes errors in the construction of wrappers for
Access_To_Subprogram types that carry pre/postconditions.

a) The formals of the subprogram body for the wrapper must be distinct
from those of the corresponding declarationm to prevent spurious
visibility errors when other homonyms appear in the subsequent code.

b) The Access_To_Subprogram type may carry default values. When the
actuals are omitted in an indirect call, the default values are inserted
in the call by means of parameter associations. As a result, the final
parameter in the call within the wrapper body (which is the pointer to a
subprogram) must appear as a parameter association as well.

Tested on x86_64-pc-linux-gnu, committed on trunk

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 mbox series

Patch

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
--- 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
--- 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),