ada: Elide the copy in extended returns for nonlimited by-reference types

This implements elision of the copy operation for extended return statements
in the case of nonlimited by-reference types (the copy operation is already
elided for limited types by the front-end and nonlimited non-by-reference
types by the code generator), which comprise controlled and tagged types.

The implementation partly reuses the machinery implemented for limited types
(the build-in-place machinery) to allocate the return object directly on the
primary or the secondary stack, depending on whether the result type of the
function is constrained or not.

This requires further special-casing for the allocators generated by this
machinery as well as an adjustment to the implementation of a specific case
of string concatenation.

gcc/ada/

	* einfo.ads (Actual_Subtype): Document additional usage.
	* exp_aggr.adb (Expand_Array_Aggregate): Replace test on
	Is_Build_In_Place_Return_Object with Is_Special_Return_Object.
	* exp_ch3.adb (Expand_N_Object_Declaration): Factor out parts of the
	processing done for build-in-place return objects and reuse them to
	implement a similar processing for specific return objects.
	* exp_ch4.adb (Expand_Allocator_Expression): Do not generate a tag
	assignment or an adjustment if the allocator was made for a special
	return object.
	(Expand_Concatenate): If the result is allocated on the secondary
	stack, use an unconstrained allocation.
	* exp_ch6.ads (Apply_CW_Accessibility_Check): New declaration.
	(Is_By_Reference_Return_Object): Likewise.
	(Is_Secondary_Stack_Return_Object): Likewise.
	(Is_Special_Return_Object): Likewise.
	* exp_ch6.adb (Expand_Ctrl_Function_Call): Do not bail out for the
	expression in the declaration of a special return object.
	(Expand_N_Extended_Return_Statement): Add missing guard and move
	the class-wide accessibility check to Expand_N_Object_Declaration.
	(Expand_Simple_Function_Return): Delete obsolete commentary.
	Skip the special processing for types that require finalization or
	are returned on the secondary stack if the return originally comes
	from an extended return statement.  Add missing Constant_Present.
	(Is_By_Reference_Return_Object): New predicate.
	(Is_Secondary_Stack_Return_Object): Likewise.
	(Is_Special_Return_Object): Likewise.
	* exp_util.adb (Is_Related_To_Func_Return): Also return true if the
	parent of the expression is the renaming declaration generated for
	the expansion of a return object.
	* gen_il-fields.ads (Opt_Field_Enum): Replace Alloc_For_BIP_Return
	with For_Special_Return_Object.
	* gen_il-gen-gen_nodes.adb (N_Allocator): Likewise.
	* gen_il-internals.adb (Image): Remove Alloc_For_BIP_Return.
	* sem_ch3.adb (Check_Return_Subtype_Indication): New procedure
	moved from sem_ch6.adb.
	(Analyze_Object_Declaration): Call it on a return object.
	* sem_ch4.adb: Add with and use clauses for Rtsfind.
	(Analyze_Allocator): Test For_Special_Return_Object to skip checks
	for allocators made for special return objects.
	Do not report restriction violations for the return stack pool.
	* sem_ch5.adb (Analyze_Assignment.Set_Assignment_Type): Return the
	Actual_Subtype for return objects that live on the secondary stack.
	* sem_ch6.adb (Check_Return_Subtype_Indication): Move procedure to
	sem_ch3.adb.
	(Analyze_Function_Return): Do not call above procedure.
	* sem_res.adb (Resolve_Allocator): Replace Alloc_For_BIP_Return
	with For_Special_Return_Object.
	* sinfo.ads: Likewise.
	* treepr.adb (Image): Remove Alloc_For_BIP_Return.
	* gcc-interface/trans.cc (gnat_to_gnu): Do not convert to the result
	type in the unconstrained array type case if the parent is a simple
	return statement.

1 files changed, 0 insertions, 135 deletions

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d567f79..f46ca46 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -746,10 +746,6 @@ package body Sem_Ch6 is
       --  Ada 2022: Check that the return expression in a No_Return function
       --  meets the conditions specified by RM 6.5.1(5.1/5).
 
-      procedure Check_Return_Subtype_Indication (Obj_Decl : Node_Id);
-      --  Check that the return_subtype_indication properly matches the result
-      --  subtype of the function, as required by RM-6.5(5.1/2-5.3/2).
-
       --------------------------------
       -- Check_No_Return_Expression --
       --------------------------------
@@ -778,135 +774,6 @@ package body Sem_Ch6 is
             Return_Expr);
       end Check_No_Return_Expression;
 
-      -------------------------------------
-      -- Check_Return_Subtype_Indication --
-      -------------------------------------
-
-      procedure Check_Return_Subtype_Indication (Obj_Decl : Node_Id) is
-         Return_Obj : constant Node_Id   := Defining_Identifier (Obj_Decl);
-
-         R_Stm_Type : constant Entity_Id := Etype (Return_Obj);
-         --  Subtype given in the extended return statement (must match R_Type)
-
-         Subtype_Ind : constant Node_Id :=
-                         Object_Definition (Original_Node (Obj_Decl));
-
-         procedure Error_No_Match (N : Node_Id);
-         --  Output error messages for case where types do not statically
-         --  match. N is the location for the messages.
-
-         --------------------
-         -- Error_No_Match --
-         --------------------
-
-         procedure Error_No_Match (N : Node_Id) is
-         begin
-            Error_Msg_N
-              ("subtype must statically match function result subtype", N);
-
-            if not Predicates_Match (R_Stm_Type, R_Type) then
-               Error_Msg_Node_2 := R_Type;
-               Error_Msg_NE
-                 ("\predicate of& does not match predicate of&",
-                  N, R_Stm_Type);
-            end if;
-         end Error_No_Match;
-
-      --  Start of processing for Check_Return_Subtype_Indication
-
-      begin
-         --  First, avoid cascaded errors
-
-         if Error_Posted (Obj_Decl) or else Error_Posted (Subtype_Ind) then
-            return;
-         end if;
-
-         --  "return access T" case; check that the return statement also has
-         --  "access T", and that the subtypes statically match:
-         --   if this is an access to subprogram the signatures must match.
-
-         if Is_Anonymous_Access_Type (R_Type) then
-            if Is_Anonymous_Access_Type (R_Stm_Type) then
-               if Ekind (Designated_Type (R_Stm_Type)) /= E_Subprogram_Type
-               then
-                  if Base_Type (Designated_Type (R_Stm_Type)) /=
-                     Base_Type (Designated_Type (R_Type))
-                    or else not Subtypes_Statically_Match (R_Stm_Type, R_Type)
-                  then
-                     Error_No_Match (Subtype_Mark (Subtype_Ind));
-                  end if;
-
-               else
-                  --  For two anonymous access to subprogram types, the types
-                  --  themselves must be type conformant.
-
-                  if not Conforming_Types
-                           (R_Stm_Type, R_Type, Fully_Conformant)
-                  then
-                     Error_No_Match (Subtype_Ind);
-                  end if;
-               end if;
-
-            else
-               Error_Msg_N ("must use anonymous access type", Subtype_Ind);
-            end if;
-
-         --  If the return object is of an anonymous access type, then report
-         --  an error if the function's result type is not also anonymous.
-
-         elsif Is_Anonymous_Access_Type (R_Stm_Type) then
-            pragma Assert (not Is_Anonymous_Access_Type (R_Type));
-            Error_Msg_N
-              ("anonymous access not allowed for function with named access "
-               & "result", Subtype_Ind);
-
-         --  Subtype indication case: check that the return object's type is
-         --  covered by the result type, and that the subtypes statically match
-         --  when the result subtype is constrained. Also handle record types
-         --  with unknown discriminants for which we have built the underlying
-         --  record view. Coverage is needed to allow specific-type return
-         --  objects when the result type is class-wide (see AI05-32).
-
-         elsif Covers (Base_Type (R_Type), Base_Type (R_Stm_Type))
-           or else (Is_Underlying_Record_View (Base_Type (R_Stm_Type))
-                     and then
-                       Covers
-                         (Base_Type (R_Type),
-                          Underlying_Record_View (Base_Type (R_Stm_Type))))
-         then
-            --  A null exclusion may be present on the return type, on the
-            --  function specification, on the object declaration or on the
-            --  subtype itself.
-
-            if Is_Access_Type (R_Type)
-              and then
-                (Can_Never_Be_Null (R_Type)
-                  or else Null_Exclusion_Present (Parent (Scope_Id))) /=
-                            Can_Never_Be_Null (R_Stm_Type)
-            then
-               Error_No_Match (Subtype_Ind);
-            end if;
-
-            --  AI05-103: for elementary types, subtypes must statically match
-
-            if Is_Constrained (R_Type) or else Is_Access_Type (R_Type) then
-               if not Subtypes_Statically_Match (R_Stm_Type, R_Type) then
-                  Error_No_Match (Subtype_Ind);
-               end if;
-            end if;
-
-         --  All remaining cases are illegal
-
-         --  Note: previous versions of this subprogram allowed the return
-         --  value to be the ancestor of the return type if the return type
-         --  was a null extension. This was plainly incorrect.
-
-         else
-            Error_Msg_N
-              ("wrong type for return_subtype_indication", Subtype_Ind);
-         end if;
-      end Check_Return_Subtype_Indication;
-
       ---------------------
       -- Local Variables --
       ---------------------
@@ -1016,8 +883,6 @@ package body Sem_Ch6 is
             Set_Is_Return_Object (Defining_Identifier (Obj_Decl));
             Analyze (Obj_Decl);
 
-            Check_Return_Subtype_Indication (Obj_Decl);
-
             if Present (HSS) then
                Analyze (HSS);