[COMMITTED] ada: Small cleanup in Expand_N_Object_Declaration

Message ID 20221121101426.259405-1-poulhies@adacore.com
State New
Headers
Series [COMMITTED] ada: Small cleanup in Expand_N_Object_Declaration |

Commit Message

Marc Poulhiès Nov. 21, 2022, 10:14 a.m. UTC
  From: Eric Botcazou <ebotcazou@adacore.com>

This reuses a local constant more consistently, removes a duplicate of this
local constant, renames local variables, alphabetizes declarations, makes a
few consistency tweaks and adjusts a couple of comments.

No functional changes.

gcc/ada/

	* exp_ch3.adb (Expand_N_Object_Declaration): Use Typ local
	constant throughout, remove Ret_Obj_Typ local constant, rename
	Ref_Type into Acc_Typ in a couple of places, remove a useless call
	to Set_Etype, use a consistent checks suppression scheme, adjust
	comments for the sake of consistencty and alphabetize some local
	declarations.
	* exp_ch6.adb (Expand_Simple_Function_Return): Remove a couple of
	redundant local constants.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_ch3.adb | 94 ++++++++++++++++++++++-----------------------
 gcc/ada/exp_ch6.adb |  8 ++--
 2 files changed, 49 insertions(+), 53 deletions(-)
  

Patch

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 90f01ca2747..7b194bb9816 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -7758,7 +7758,7 @@  package body Exp_Ch3 is
             if Validity_Checks_On
               and then Comes_From_Source (N)
               and then Validity_Check_Copies
-              and then not Is_Generic_Type (Etype (Def_Id))
+              and then not Is_Generic_Type (Typ)
             then
                Ensure_Valid (Expr);
                if Safe_To_Capture_Value (N, Def_Id) then
@@ -7876,7 +7876,7 @@  package body Exp_Ch3 is
       end if;
 
       if Nkind (Obj_Def) = N_Access_Definition
-        and then not Is_Local_Anonymous_Access (Etype (Def_Id))
+        and then not Is_Local_Anonymous_Access (Typ)
       then
          --  An Ada 2012 stand-alone object of an anonymous access type
 
@@ -7988,16 +7988,17 @@  package body Exp_Ch3 is
 
       --    if BIPalloc = 1 then
       --       Rxx := BIPaccess;
+      --       Rxx.all := <expression>;
       --    elsif BIPalloc = 2 then
-      --       Rxx := new <expression-type>[storage_pool =
+      --       Rxx := new <expression-type>'(<expression>)[storage_pool =
       --         system__secondary_stack__ss_pool][procedure_to_call =
       --         system__secondary_stack__ss_allocate];
       --    elsif BIPalloc = 3 then
-      --       Rxx := new <expression-type>
+      --       Rxx := new <expression-type>'(<expression>)
       --    elsif BIPalloc = 4 then
       --       Pxx : system__storage_pools__root_storage_pool renames
       --         BIPstoragepool.all;
-      --       Rxx := new <expression-type>[storage_pool =
+      --       Rxx := new <expression-type>'(<expression>)[storage_pool =
       --         Pxx][procedure_to_call =
       --         system__storage_pools__allocate_any];
       --    else
@@ -8005,15 +8006,12 @@  package body Exp_Ch3 is
       --    end if;
 
       --    Result : T renames Rxx.all;
-      --    Result := <expression>;
 
       --  in the unconstrained case.
 
       if Is_Build_In_Place_Return_Object (Def_Id) then
          declare
-            Func_Id     : constant Entity_Id :=
-              Return_Applies_To (Scope (Def_Id));
-            Ret_Obj_Typ : constant Entity_Id := Etype (Def_Id);
+            Func_Id : constant Entity_Id := Return_Applies_To (Scope (Def_Id));
 
             Init_Stmt       : Node_Id;
             Obj_Acc_Formal  : Entity_Id;
@@ -8043,9 +8041,9 @@  package body Exp_Ch3 is
             if Present (Expr_Q)
               and then not Is_Delayed_Aggregate (Expr_Q)
               and then not No_Initialization (N)
-              and then not Is_Interface (Etype (Def_Id))
+              and then not Is_Interface (Typ)
             then
-               if Is_Class_Wide_Type (Etype (Def_Id))
+               if Is_Class_Wide_Type (Typ)
                  and then not Is_Class_Wide_Type (Etype (Expr_Q))
                then
                   Init_Stmt :=
@@ -8054,7 +8052,7 @@  package body Exp_Ch3 is
                       Expression =>
                         Make_Type_Conversion (Loc,
                           Subtype_Mark =>
-                            New_Occurrence_Of (Etype (Def_Id), Loc),
+                            New_Occurrence_Of (Typ, Loc),
                           Expression   => New_Copy_Tree (Expr_Q)));
 
                else
@@ -8087,12 +8085,12 @@  package body Exp_Ch3 is
             if Needs_BIP_Alloc_Form (Func_Id) then
                declare
                   Desig_Typ : constant Entity_Id :=
-                    (if Ekind (Ret_Obj_Typ) = E_Array_Subtype
-                     then Etype (Func_Id) else Ret_Obj_Typ);
+                    (if Ekind (Typ) = E_Array_Subtype
+                     then Etype (Func_Id) else Typ);
                   --  Ensure that the we use a fat pointer when allocating
                   --  an unconstrained array on the heap. In this case the
-                  --  result object type is a constrained array type even
-                  --  though the function type is unconstrained.
+                  --  result object's type is a constrained array type even
+                  --  though the function's type is unconstrained.
                   Obj_Alloc_Formal : constant Entity_Id :=
                     Build_In_Place_Formal (Func_Id, BIP_Alloc_Form);
                   Pool_Id          : constant Entity_Id :=
@@ -8135,7 +8133,7 @@  package body Exp_Ch3 is
                         --  use the type of the expression, which must be an
                         --  aggregate of a definite type.
 
-                        if Is_Class_Wide_Type (Ret_Obj_Typ) then
+                        if Is_Class_Wide_Type (Typ) then
                            Alloc :=
                              Make_Allocator (Loc,
                                Expression =>
@@ -8145,7 +8143,7 @@  package body Exp_Ch3 is
                            Alloc :=
                              Make_Allocator (Loc,
                                Expression =>
-                                 New_Occurrence_Of (Ret_Obj_Typ, Loc));
+                                 New_Occurrence_Of (Typ, Loc));
                         end if;
 
                         --  If the object requires default initialization then
@@ -8165,33 +8163,33 @@  package body Exp_Ch3 is
                      return Alloc;
                   end Make_Allocator_For_BIP_Return;
 
-                  Alloc_Obj_Id   : Entity_Id;
+                  Acc_Typ        : Entity_Id;
                   Alloc_Obj_Decl : Node_Id;
-                  Alloc_Stmt      : Node_Id;
+                  Alloc_Obj_Id   : Entity_Id;
+                  Alloc_Stmt     : Node_Id;
                   Guard_Except   : Node_Id;
                   Heap_Allocator : Node_Id;
-                  Pool_Decl      : Node_Id;
                   Pool_Allocator : Node_Id;
-                  Ptr_Type_Decl  : Node_Id;
-                  Ref_Type       : Entity_Id;
+                  Pool_Decl      : Node_Id;
+                  Ptr_Typ_Decl   : Node_Id;
                   SS_Allocator   : Node_Id;
 
                begin
                   --  Create an access type designating the function's
                   --  result subtype.
 
-                  Ref_Type := Make_Temporary (Loc, 'A');
+                  Acc_Typ := Make_Temporary (Loc, 'A');
 
-                  Ptr_Type_Decl :=
+                  Ptr_Typ_Decl :=
                     Make_Full_Type_Declaration (Loc,
-                      Defining_Identifier => Ref_Type,
+                      Defining_Identifier => Acc_Typ,
                       Type_Definition     =>
                         Make_Access_To_Object_Definition (Loc,
                           All_Present        => True,
                           Subtype_Indication =>
                             New_Occurrence_Of (Desig_Typ, Loc)));
 
-                  Insert_Action (N, Ptr_Type_Decl);
+                  Insert_Action (N, Ptr_Typ_Decl, Suppress => All_Checks);
 
                   --  Create an access object that will be initialized to an
                   --  access value denoting the return object, either coming
@@ -8199,15 +8197,14 @@  package body Exp_Ch3 is
                   --  or from the result of an allocator.
 
                   Alloc_Obj_Id := Make_Temporary (Loc, 'R');
-                  Set_Etype (Alloc_Obj_Id, Ref_Type);
 
                   Alloc_Obj_Decl :=
                     Make_Object_Declaration (Loc,
                       Defining_Identifier => Alloc_Obj_Id,
                       Object_Definition   =>
-                        New_Occurrence_Of (Ref_Type, Loc));
+                        New_Occurrence_Of (Acc_Typ, Loc));
 
-                  Insert_Action (N, Alloc_Obj_Decl);
+                  Insert_Action (N, Alloc_Obj_Decl, Suppress => All_Checks);
 
                   --  First create the Heap_Allocator
 
@@ -8320,7 +8317,7 @@  package body Exp_Ch3 is
                   --  to-unconstrained to access-to-constrained), but the
                   --  the unchecked conversion will presumably fail to work
                   --  right in just such cases. It's not clear at all how to
-                  --  handle this. ???
+                  --  handle this.
 
                   Alloc_Stmt :=
                     Make_If_Statement (Loc,
@@ -8339,7 +8336,7 @@  package body Exp_Ch3 is
                             New_Occurrence_Of (Alloc_Obj_Id, Loc),
                           Expression =>
                             Unchecked_Convert_To
-                              (Ref_Type,
+                              (Acc_Typ,
                                New_Occurrence_Of (Obj_Acc_Formal, Loc)))),
 
                       Elsif_Parts => New_List (
@@ -8372,12 +8369,12 @@  package body Exp_Ch3 is
                           Then_Statements => New_List (
                             Build_Heap_Or_Pool_Allocator
                               (Temp_Id    => Alloc_Obj_Id,
-                               Temp_Typ   => Ref_Type,
+                               Temp_Typ   => Acc_Typ,
                                Func_Id    => Func_Id,
                                Ret_Typ    => Desig_Typ,
                                Alloc_Expr => Heap_Allocator))),
 
-                        --  ???If all is well, we can put the following
+                        --  ??? If all is well, we can put the following
                         --  'elsif' in the 'else', but this is a useful
                         --  self-check in case caller and callee don't agree
                         --  on whether BIPAlloc and so on should be passed.
@@ -8396,7 +8393,7 @@  package body Exp_Ch3 is
                             Pool_Decl,
                             Build_Heap_Or_Pool_Allocator
                               (Temp_Id    => Alloc_Obj_Id,
-                               Temp_Typ   => Ref_Type,
+                               Temp_Typ   => Acc_Typ,
                                Func_Id    => Func_Id,
                                Ret_Typ    => Desig_Typ,
                                Alloc_Expr => Pool_Allocator)))),
@@ -8437,33 +8434,33 @@  package body Exp_Ch3 is
                   Obj_Acc_Formal := Alloc_Obj_Id;
                end;
 
-            --  When the function's subtype is unconstrained and a run-time
-            --  test is not needed, we nevertheless need to build the return
-            --  using the function's result subtype.
+            --  When the function's type is unconstrained and a run-time test
+            --  is not needed, we nevertheless need to build the return using
+            --  the return object's type.
 
             elsif not Is_Constrained (Underlying_Type (Etype (Func_Id))) then
                declare
-                  Alloc_Obj_Id   : Entity_Id;
+                  Acc_Typ        : Entity_Id;
                   Alloc_Obj_Decl : Node_Id;
-                  Ptr_Type_Decl  : Node_Id;
-                  Ref_Type       : Entity_Id;
+                  Alloc_Obj_Id   : Entity_Id;
+                  Ptr_Typ_Decl   : Node_Id;
 
                begin
                   --  Create an access type designating the function's
                   --  result subtype.
 
-                  Ref_Type := Make_Temporary (Loc, 'A');
+                  Acc_Typ := Make_Temporary (Loc, 'A');
 
-                  Ptr_Type_Decl :=
+                  Ptr_Typ_Decl :=
                     Make_Full_Type_Declaration (Loc,
-                      Defining_Identifier => Ref_Type,
+                      Defining_Identifier => Acc_Typ,
                       Type_Definition     =>
                         Make_Access_To_Object_Definition (Loc,
                           All_Present        => True,
                           Subtype_Indication =>
-                            New_Occurrence_Of (Ret_Obj_Typ, Loc)));
+                            New_Occurrence_Of (Typ, Loc)));
 
-                  Insert_Action (N, Ptr_Type_Decl);
+                  Insert_Action (N, Ptr_Typ_Decl, Suppress => All_Checks);
 
                   --  Create an access object initialized to the conversion
                   --  of the implicit access value passed in by the caller.
@@ -8477,11 +8474,10 @@  package body Exp_Ch3 is
                     Make_Object_Declaration (Loc,
                       Defining_Identifier => Alloc_Obj_Id,
                       Object_Definition   =>
-                        New_Occurrence_Of (Ref_Type, Loc),
+                        New_Occurrence_Of (Acc_Typ, Loc),
                       Expression =>
                         Unchecked_Convert_To
-                          (Ref_Type,
-                           New_Occurrence_Of (Obj_Acc_Formal, Loc)));
+                          (Acc_Typ, New_Occurrence_Of (Obj_Acc_Formal, Loc)));
 
                   Insert_Action (N, Alloc_Obj_Decl, Suppress => All_Checks);
 
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 1466e4dc36a..4cdd98649c8 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -6650,8 +6650,8 @@  package body Exp_Ch6 is
                           and then Needs_Finalization (Exp_Typ))
          then
             declare
-               Loc        : constant Source_Ptr := Sloc (N);
-               Acc_Typ    : constant Entity_Id := Make_Temporary (Loc, 'A');
+               Acc_Typ : constant Entity_Id := Make_Temporary (Loc, 'A');
+
                Alloc_Node : Node_Id;
                Temp       : Entity_Id;
 
@@ -6753,8 +6753,8 @@  package body Exp_Ch6 is
                           and then Needs_Finalization (Exp_Typ))
          then
             declare
-               Loc        : constant Source_Ptr := Sloc (N);
-               Acc_Typ    : constant Entity_Id := Make_Temporary (Loc, 'A');
+               Acc_Typ : constant Entity_Id := Make_Temporary (Loc, 'A');
+
                Alloc_Node : Node_Id;
                Temp       : Entity_Id;