From patchwork Mon Nov 21 10:14:26 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 60916 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 719E4393BA60 for ; Mon, 21 Nov 2022 10:17:33 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 719E4393BA60 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1669025853; bh=Fj3CTdaj73CnLq4pmQlo3W51IKGhbhZ2MGIcaiuA1Mk=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=iD9G6qIZK5/AdZLSKc8PS82CnpymMR3Lg7xAl9v78z09ZluP4JuOg2usys+niBdvY nefBk6RVvQ1d1T55uRsAx7I6iq3NRw5Euew9P7OjWSayDCKV3jU1Ua0IqHaO8hVjnJ 3b2m1ANwadETfsy/xtSAd65ey8X4pSARni41JMok= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x434.google.com (mail-wr1-x434.google.com [IPv6:2a00:1450:4864:20::434]) by sourceware.org (Postfix) with ESMTPS id 205FB382FAFA for ; Mon, 21 Nov 2022 10:14:30 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 205FB382FAFA Received: by mail-wr1-x434.google.com with SMTP id bs21so19089293wrb.4 for ; Mon, 21 Nov 2022 02:14:30 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=Fj3CTdaj73CnLq4pmQlo3W51IKGhbhZ2MGIcaiuA1Mk=; b=ZC3ibn7SofL8hjECz4eaen+hdIaSVOQMunJp34yOaW28BWbGP/gjp8Bj6rsfcoZoTf 5sP58tlUiX1vQOwayVHQXrNEO5Xj2j+mhAKhev5eDWtKyOyiuRF0b2mp+H8UGShymjze k2ZLDgOdMpOJc3Hp19UmnYb7BZPmNwjKLxdsHb2xqa3xPLvgygX3vGP15Wf6mlZnaP2G /VGQLxBnpzJA8kMkVtnnxHUnj4PN7EFvE1rL4365JTbLEXJsTEDII61nmvBFENwCH3it Y7ZNJdXx+l0vx6/943TfQQjACOMgLq1P8ZZHw/lvn8owXLScUoezJiVu6AkPo1dnoXvg Eiyw== X-Gm-Message-State: ANoB5pk6pQnCoK1RFGnsfa18WEh2vCxwmxF7R32q+A5gW/1LGEuIa+/y t4hkXEHLmJfuFVM9+kHo7ta94vPF4Twy8w== X-Google-Smtp-Source: AA0mqf6BQ3Nf5djxGNy05k2OnFtF7XJ2o6oD0ejHeIYfSS9NZDbvpdUdjiZuqsBosZvDQiNxw1eqzA== X-Received: by 2002:a5d:508f:0:b0:232:c489:90e6 with SMTP id a15-20020a5d508f000000b00232c48990e6mr4616086wrt.68.1669025668864; Mon, 21 Nov 2022 02:14:28 -0800 (PST) Received: from localhost.localdomain (static-176-191-105-132.ftth.abo.bbox.fr. [176.191.105.132]) by smtp.gmail.com with ESMTPSA id n9-20020a05600c3b8900b003c6bbe910fdsm23718120wms.9.2022.11.21.02.14.27 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 21 Nov 2022 02:14:28 -0800 (PST) To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Small cleanup in Expand_N_Object_Declaration Date: Mon, 21 Nov 2022 11:14:26 +0100 Message-Id: <20221121101426.259405-1-poulhies@adacore.com> X-Mailer: git-send-email 2.34.1 MIME-Version: 1.0 X-Spam-Status: No, score=-13.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: =?utf-8?q?Marc_Poulhi=C3=A8s_via_Gcc-patches?= From: =?utf-8?q?Marc_Poulhi=C3=A8s?= Reply-To: =?utf-8?q?Marc_Poulhi=C3=A8s?= Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" From: Eric Botcazou 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(-) 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 := ; -- elsif BIPalloc = 2 then - -- Rxx := new [storage_pool = + -- Rxx := new '()[storage_pool = -- system__secondary_stack__ss_pool][procedure_to_call = -- system__secondary_stack__ss_allocate]; -- elsif BIPalloc = 3 then - -- Rxx := new + -- Rxx := new '() -- elsif BIPalloc = 4 then -- Pxx : system__storage_pools__root_storage_pool renames -- BIPstoragepool.all; - -- Rxx := new [storage_pool = + -- Rxx := new '()[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 := ; -- 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;