[gcc r13-890] [Ada] Another case where freezing incorrectly suppresses checks

[gcc r13-890] [Ada] Another case where freezing incorrectly suppresses checks

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:b1743c7de2cc3473d5efc2f16495acd2b71d7591

commit r13-890-gb1743c7de2cc3473d5efc2f16495acd2b71d7591
Author: Steve Baird <baird@adacore.com>
Date:   Wed May 4 16:23:40 2022 -0700

    [Ada] Another case where freezing incorrectly suppresses checks
    
    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.
    
    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:
---
 gcc/ada/exp_ch13.adb | 12 ++++++++----
 gcc/ada/exp_ch3.adb  |  7 +++++++
 2 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/gcc/ada/exp_ch13.adb b/gcc/ada/exp_ch13.adb
index 6b6da818387..d2be185aa56 100644
--- 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
index 03ff9258926..5403f3b4f64 100644
--- 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;