From c1a69c98717d9c63ffde67746c56243d530c9109 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sat, 14 Nov 2020 16:12:04 +0100 Subject: [PATCH] [Ada] Fix internal error on extended return and fixed-point result gcc/ada/ * contracts.adb (Check_Type_Or_Object_External_Properties): Make sure to exclude all return objects from the SPARK legality rule on effectively volatile variables. * exp_ch6.adb (Expand_N_Extended_Return_Statement): Use the fast track only when the declaration of the return object can be dropped. --- gcc/ada/contracts.adb | 7 +++++-- gcc/ada/exp_ch6.adb | 23 ++++++++++------------- 2 files changed, 15 insertions(+), 15 deletions(-) diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb index 1b15d99f02b..7387ffe6347 100644 --- a/gcc/ada/contracts.adb +++ b/gcc/ada/contracts.adb @@ -905,9 +905,12 @@ package body Contracts is -- The following checks are relevant only when SPARK_Mode is on, as -- they are not standard Ada legality rules. Internally generated - -- temporaries are ignored. + -- temporaries are ignored, as well as return objects. - if SPARK_Mode = On and then Comes_From_Source (Type_Or_Obj_Id) then + if SPARK_Mode = On + and then Comes_From_Source (Type_Or_Obj_Id) + and then not Is_Return_Object (Type_Or_Obj_Id) + then if Is_Effectively_Volatile (Type_Or_Obj_Id) then -- The declaration of an effectively volatile object or type must diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index f5a1d666b6c..98a1ceba8c2 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -5384,13 +5384,15 @@ package body Exp_Ch6 is end if; -- Build a simple_return_statement that returns the return object when - -- there is a statement sequence, or no expression, or the result will - -- be built in place. Note however that we currently do this for all - -- composite cases, even though not all are built in place. + -- there is a statement sequence, or no expression, or the analysis of + -- the return object declaration generated extra actions, or the result + -- will be built in place. Note however that we currently do this for + -- all composite cases, even though they are not built in place. if Present (HSS) - or else Is_Composite_Type (Ret_Typ) or else No (Exp) + or else List_Length (Return_Object_Declarations (N)) > 1 + or else Is_Composite_Type (Ret_Typ) then if No (HSS) then Stmts := New_List; @@ -6058,16 +6060,11 @@ package body Exp_Ch6 is end; end if; - -- Case where we do not build a block - - else - -- We're about to drop Return_Object_Declarations on the floor, so - -- we need to insert it, in case it got expanded into useful code. - -- Remove side effects from expression, which may be duplicated in - -- subsequent checks (see Expand_Simple_Function_Return). + -- Case where we do not need to build a block. But we're about to drop + -- Return_Object_Declarations on the floor, so assert that it contains + -- only the return object declaration. - Insert_List_Before (N, Return_Object_Declarations (N)); - Remove_Side_Effects (Exp); + else pragma Assert (List_Length (Return_Object_Declarations (N)) = 1); -- Build simple_return_statement that returns the expression directly -- 2.30.2