diff options
| author | Eric Botcazou <ebotcazou@adacore.com> | 2020-11-14 16:12:04 +0100 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-11-30 09:16:20 -0500 |
| commit | c1a69c98717d9c63ffde67746c56243d530c9109 (patch) | |
| tree | 6767fb0010c1feca3ca5dc51413a51a2111d56e5 /gcc | |
| parent | f7937111e8c8cfaf5ea79d97c65d6b6dc29b261f (diff) | |
| download | gcc-c1a69c98717d9c63ffde67746c56243d530c9109.zip gcc-c1a69c98717d9c63ffde67746c56243d530c9109.tar.gz gcc-c1a69c98717d9c63ffde67746c56243d530c9109.tar.bz2 | |
[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.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/contracts.adb | 7 | ||||
| -rw-r--r-- | 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 1b15d99f..7387ffe 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 f5a1d66..98a1ceb 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 |