[COMMITTED] ada: Fix spurious freezing error on nonabstract null extension

Message ID 20230522085103.1726874-1-poulhies@adacore.com
State Accepted
Headers
Series [COMMITTED] ada: Fix spurious freezing error on nonabstract null extension |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Marc Poulhiès May 22, 2023, 8:51 a.m. UTC
  From: Eric Botcazou <ebotcazou@adacore.com>

This prevents the wrapper function created for each nonoverridden inherited
function with a controlling result of nonabstract null extensions of tagged
types from causing premature freezing of types referenced in its profile.

gcc/ada/

	* exp_ch3.adb (Make_Controlling_Function_Wrappers): Create the body
	as the expanded body of an expression function.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch3.adb | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)
  

Patch

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index b8ab549c0fc..3a023092532 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -11109,9 +11109,10 @@  package body Exp_Ch3 is
                 Null_Record_Present => True);
 
             --  GNATprove will use expression of an expression function as an
-            --  implicit postcondition. GNAT will not benefit from expression
-            --  function (and would struggle if we add an expression function
-            --  to freezing actions).
+            --  implicit postcondition. GNAT will also benefit from expression
+            --  function to avoid premature freezing, but would struggle if we
+            --  added an expression function to freezing actions, so we create
+            --  the expanded form directly.
 
             if GNATprove_Mode then
                Func_Body :=
@@ -11130,6 +11131,7 @@  package body Exp_Ch3 is
                        Statements => New_List (
                          Make_Simple_Return_Statement (Loc,
                            Expression => Ext_Aggr))));
+               Set_Was_Expression_Function (Func_Body);
             end if;
 
             Append_To (Body_List, Func_Body);