Avoid improperly suppressing checks for the wrapper subprogram that is
built when a null type extension inherits (and does not override) a
function with a controlling result. This is a follow-up to other changes
already made on this ticket.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* exp_ch3.adb (Make_Controlling_Function_Wrappers): Set the
Corresponding_Spec field of a wrapper subprogram body before
analyzing the subprogram body; the field will be set (again)
during analysis, but we need it to be set earlier.
* exp_ch13.adb (Expand_N_Freeze_Entity): Add wrapper subprogram
bodies to the list of declarations for which we do not want to
suppress checks.
diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb
--- a/gcc/ada/exp_ch13.adb
+++ b/gcc/ada/exp_ch13.adb
@@ -626,10 +626,10 @@ package body Exp_Ch13 is
end if;
-- Analyze actions generated by freezing. The init_proc contains source
- -- expressions that may raise Constraint_Error, and the assignment
+ -- expressions that may raise Constraint_Error, the assignment
-- procedure for complex types needs checks on individual component
- -- assignments, but all other freezing actions should be compiled with
- -- all checks off.
+ -- assignments, and wrappers may need checks. Other freezing actions
+ -- should be compiled with all checks off.
if Present (Actions (N)) then
Decl := First (Actions (N));
@@ -637,7 +637,11 @@ package body Exp_Ch13 is
if Nkind (Decl) = N_Subprogram_Body
and then (Is_Init_Proc (Defining_Entity (Decl))
or else
- Chars (Defining_Entity (Decl)) = Name_uAssign)
+ Chars (Defining_Entity (Decl)) = Name_uAssign
+ or else
+ (Present (Corresponding_Spec (Decl))
+ and then Is_Wrapper
+ (Corresponding_Spec (Decl))))
then
Analyze (Decl);
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
@@ -10031,6 +10031,13 @@ package body Exp_Ch3 is
Mutate_Ekind (Func_Id, E_Function);
Set_Is_Wrapper (Func_Id);
+ -- Corresponding_Spec will be set again to the same value during
+ -- analysis, but we need this information earlier.
+ -- Expand_N_Freeze_Entity needs to know whether a subprogram body
+ -- is a wrapper's body in order to get check suppression right.
+
+ Set_Corresponding_Spec (Func_Body, Func_Id);
+
Override_Dispatching_Operation (Tag_Typ, Subp, New_Op => Func_Id);
end if;