[Ada] Static expression function problems with -gnatc and -gnatd.F (SPARK mode)

gcc/ada/

	* exp_ch6.adb (Expand_Simple_Function_Return): Remove ugly code
	that was copying the return expression, resetting Analyzed
	flags, etc. for the return expression of static expression
	functions.
	* inline.adb (Inline_Static_Expression_Function_Call): Set the
	Parent of the copied expression to that of the call. This avoids
	a blowup in Insert_Actions when GNATprove_Mode is set and there
	are nested SEF calls. Add ??? comment.
	* sem_ch6.adb (Analyze_Expression_Function): In the case of a
	static expression function, create a new copy of the expression
	and replace the function's expression with the copy; the
	original expression is used in the expression function's body
	and will be analyzed and rewritten, and we need to save a clean
	copy for later use in processing static calls to the function.
	This allows removing the kludgy code that was in
	Expand_Simple_Function_Return.
	* sem_eval.adb (Eval_Qualified_Expression): Return immediately
	if any errors have been posted on the qualified expression, to
	avoid blowups when GNATprove_Mode is enabled (or with -gnatd.F),
	since illegal static expressions are handled differently in that
	case and attempting to fold such expressions would fail.

4 files changed, 28 insertions, 39 deletions

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 8efada4..c882630 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -7356,33 +7356,9 @@ package body Exp_Ch6 is
                  Reason => PE_Accessibility_Check_Failed));
       end Check_Against_Result_Level;
 
-      --  Local Data
-
-      New_Copy_Of_Exp : Node_Id := Empty;
-
    --  Start of processing for Expand_Simple_Function_Return
 
    begin
-      --  For static expression functions, the expression of the function
-      --  needs to be available in a form that can be replicated later for
-      --  calls, but rewriting of the return expression in the body created
-      --  for expression functions will cause the original expression to no
-      --  longer be properly copyable via New_Copy_Tree, because the Parent
-      --  fields of the nodes will now point to nodes in the rewritten tree,
-      --  and New_Copy_Tree won't copy the deeper nodes of the original tree.
-      --  So we work around that by making a copy of the expression tree
-      --  before any rewriting occurs, and replacing the original expression
-      --  tree with this copy (see the end of this procedure). We also reset
-      --  the Analyzed flags on the nodes in the tree copy to ensure that
-      --  later copies of the tree will be fully reanalyzed. This copying
-      --  is of course rather inelegant, to say the least, and it would be
-      --  nice if there were a way to avoid it. ???
-
-      if Is_Static_Expression_Function (Scope_Id) then
-         New_Copy_Of_Exp := New_Copy_Tree (Exp);
-         Reset_Analyzed_Flags (New_Copy_Of_Exp);
-      end if;
-
       if Is_Class_Wide_Type (R_Type)
         and then not Is_Class_Wide_Type (Exp_Typ)
         and then Nkind (Exp) /= N_Type_Conversion
@@ -8094,21 +8070,6 @@ package body Exp_Ch6 is
          Analyze_And_Resolve (Exp);
       end if;
 
-      --  If a new copy of a static expression function's expression was made
-      --  (see the beginning of this procedure's statement part), then we now
-      --  replace the original expression tree with the copy and also change
-      --  the Original_Node field of the rewritten expression to point to that
-      --  copy. It would be nice to find a way to avoid this???
-
-      if Present (New_Copy_Of_Exp) then
-         Set_Expression
-           (Original_Node (Subprogram_Spec (Scope_Id)), New_Copy_Of_Exp);
-
-         if Exp /= Original_Node (Exp) then
-            Set_Original_Node (Exp, New_Copy_Of_Exp);
-         end if;
-      end if;
-
       --  Ada 2020 (AI12-0279)
 
       if Has_Yield_Aspect (Scope_Id)
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index d1a6ee3..53ca685 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -4714,6 +4714,13 @@ package body Inline is
 
          Establish_Actual_Mapping_For_Inlined_Call (N, Subp, Decls, Func_Expr);
 
+         --  Ensure that the copy has the same parent as the call (this seems
+         --  to matter when GNATprove_Mode is set and there are nested static
+         --  calls; prevents blowups in Insert_Actions, though it's not clear
+         --  exactly why this is needed???).
+
+         Set_Parent (Expr_Copy, Parent (N));
+
          Insert_Actions (N, Decls);
 
          --  Now substitute actuals for their corresponding formal references
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 7c6175f..0785c1c 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -598,6 +598,19 @@ package body Sem_Ch6 is
                         Set_Checking_Potentially_Static_Expression (False);
                      end;
                   end if;
+
+                  --  We also make an additional copy of the expression and
+                  --  replace the expression of the expression function with
+                  --  this copy, because the currently present expression is
+                  --  now associated with the body created for the static
+                  --  expression function, which will later be analyzed and
+                  --  possibly rewritten, and we need to have the separate
+                  --  unanalyzed copy available for use with later static
+                  --  calls.
+
+                  Set_Expression
+                    (Original_Node (Subprogram_Spec (Def_Id)),
+                     New_Copy_Tree (Expr));
                end if;
             end if;
          end;
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 2063316..57dbaba 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -3243,6 +3243,14 @@ package body Sem_Eval is
          end if;
 
          return;
+
+      --  Also return if a semantic error has been posted on the node, as we
+      --  don't want to fold in that case (for GNATprove, the node might lead
+      --  to Constraint_Error but won't have been replaced with a raise node
+      --  or marked as raising CE).
+
+      elsif Error_Posted (N) then
+         return;
       end if;
 
       --  If not foldable we are done