From 85f6d7e2d277bc7d409302673892ff2ca2c45535 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Sun, 17 May 2020 17:57:05 -0400 Subject: [PATCH] [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. --- gcc/ada/exp_ch6.adb | 39 --------------------------------------- gcc/ada/inline.adb | 7 +++++++ gcc/ada/sem_ch6.adb | 13 +++++++++++++ gcc/ada/sem_eval.adb | 8 ++++++++ 4 files changed, 28 insertions(+), 39 deletions(-) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 8efada408b4..c882630fd1c 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 d1a6ee3760f..53ca6853673 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 7c6175fa07c..0785c1cab4c 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 20633167445..57dbaba886d 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 -- 2.30.2