ada: Fix compiler crash on primitive completed by expression function

This further restricts the special bypass for the freezing of the profile
in Analyze_Subprogram_Body_Helper to the case of wrapper functions.

gcc/ada/ChangeLog:

	PR ada/93702
	* exp_ch3.adb (Make_Controlling_Function_Wrappers): Do not set the
	Was_Expression_Function flag on the body.
	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Avoid freezing the
	profile only for wrapper functions.

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 6734c84986338d1f91402ec1f7916de0dc30956a..e8bccb22872bb25457216cb419483033244345ae 100644 (file)
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -11661,10 +11661,9 @@ package body Exp_Ch3 is
                 Null_Record_Present => True);
 
             --  GNATprove will use expression of an expression function as an
-            --  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.
+            --  implicit postcondition. GNAT will not benefit from expression
+            --  function (and would struggle if we add an expression function
+            --  to freezing actions).
 
             if GNATprove_Mode then
                Func_Body :=
@@ -11683,7 +11682,6 @@ 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);

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index dc9dd449ab8afa117b0c5f25c3fa8fa7dcb32f0d..b5a949d2a0e6279702ff674164ad6ae7454d7e7b 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -3833,20 +3833,14 @@ package body Sem_Ch6 is
          --  In particular, extra formals for accessibility or build-in-place
          --  return purposes may still need to be generated. Freeze nodes are
          --  inserted before the body, and are necessary to ensure the proper
-         --  elaboration order in the code generator.
-
-         --  A further complication arises when the expression function is a
-         --  primitive operation of a tagged type: in that case the function
-         --  entity must be frozen before the dispatch table for the type is
-         --  built, but this freezing must not freeze the tagged type itself.
+         --  elaboration order in the code generator. But we do not freeze the
+         --  profile for them to avoid premature freezing of tagged types.
 
          if not Is_Frozen (Spec_Id) and then Serious_Errors_Detected = 0 then
             Set_Has_Delayed_Freeze (Spec_Id);
             Create_Extra_Formals (Spec_Id, Related_Nod => N);
             Freeze_Before (N, Spec_Id,
-              Do_Freeze_Profile => not
-                (From_Expression_Function
-                  and then Is_Dispatching_Operation (Spec_Id)));
+              Do_Freeze_Profile => not Is_Wrapper (Spec_Id));
          end if;
       end if;