From: Steve Baird <baird@adacore.com>
Date: Wed, 4 May 2022 23:23:40 +0000 (-0700)
Subject: [Ada] Another case where freezing incorrectly suppresses checks
X-Git-Tag: basepoints/gcc-14~6317
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=b1743c7de2cc3473d5efc2f16495acd2b71d7591;p=thirdparty%2Fgcc.git

[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 --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;