[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.

diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index 1b15d99f02bbee5a2b556ae42c10b953f2aef876..7387ffe634734eb13748b26f4d0ca0bf4ec8f9f7 100644 (file)
--- 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 f5a1d666b6cf42bc33928f841a2758f79b692eee..98a1ceba8c2daf17480216cfc5671ede6576a88d 100644 (file)
--- 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