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 --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),
