From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id C05213851150; Mon, 4 Jul 2022 07:51:13 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org C05213851150 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-1438] [Ada] Tech debt: Remove code duplication X-Act-Checkin: gcc X-Git-Author: Justin Squirek X-Git-Refname: refs/heads/master X-Git-Oldrev: 1fde86bba55ea61b56f79798c6ac4cc6808e51a1 X-Git-Newrev: 78f13b008ab58794057847a74903ee4569829d80 Message-Id: <20220704075113.C05213851150@sourceware.org> Date: Mon, 4 Jul 2022 07:51:13 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 04 Jul 2022 07:51:13 -0000 https://gcc.gnu.org/g:78f13b008ab58794057847a74903ee4569829d80 commit r13-1438-g78f13b008ab58794057847a74903ee4569829d80 Author: Justin Squirek Date: Thu May 26 15:02:01 2022 +0000 [Ada] Tech debt: Remove code duplication This patch corrects removes some code duplication within the GNAT compiler. gcc/ada/ * exp_util.adb (Remove_Side_Effects): Combine identical branches. * sem_attr.adb (Analyze_Attribute): Combine identical cases Attribute_Has_Same_Storage and Attribute_Overlaps_Storage. * sem_prag.adb (Check_Role): Combine E_Out_Parameter case with general case for parameters. * sem_util.adb (Accessibility_Level): Combine identical branches. * sprint.adb (Sprint_Node_Actual): Combine cases for N_Real_Range_Specification and N_Signed_Integer_Type_Definition. Diff: --- gcc/ada/exp_util.adb | 34 +++++++++++++-------------------- gcc/ada/sem_attr.adb | 19 +++--------------- gcc/ada/sem_prag.adb | 37 ++++++++--------------------------- gcc/ada/sem_util.adb | 54 +++++++++++++++++++--------------------------------- gcc/ada/sprint.adb | 10 +++------- 5 files changed, 47 insertions(+), 107 deletions(-) diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 2a7afd4fa9e..eaf7ebf8561 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -12017,31 +12017,23 @@ package body Exp_Util is -- renaming is handled by the front end, as the back end may balk at -- the nonstandard representation (see Evaluation_Required in Exp_Ch8). - elsif Nkind (Exp) in N_Indexed_Component | N_Selected_Component - and then Has_Non_Standard_Rep (Etype (Prefix (Exp))) - then - Def_Id := Build_Temporary (Loc, 'R', Exp); - Res := New_Occurrence_Of (Def_Id, Loc); - - Insert_Action (Exp, - Make_Object_Renaming_Declaration (Loc, - Defining_Identifier => Def_Id, - Subtype_Mark => New_Occurrence_Of (Exp_Type, Loc), - Name => Relocate_Node (Exp))); + elsif (Nkind (Exp) in N_Indexed_Component | N_Selected_Component + and then Has_Non_Standard_Rep (Etype (Prefix (Exp)))) - -- For an expression that denotes a name, we can use a renaming scheme. - -- This is needed for correctness in the case of a volatile object of - -- a nonvolatile type because the Make_Reference call of the "default" - -- approach would generate an illegal access value (an access value - -- cannot designate such an object - see Analyze_Reference). + -- For an expression that denotes a name, we can use a renaming + -- scheme. This is needed for correctness in the case of a volatile + -- object of a nonvolatile type because the Make_Reference call of the + -- "default" approach would generate an illegal access value (an + -- access value cannot designate such an object - see + -- Analyze_Reference). - elsif Is_Name_Reference (Exp) + or else (Is_Name_Reference (Exp) - -- We skip using this scheme if we have an object of a volatile - -- type and we do not have Name_Req set true (see comments for - -- Side_Effect_Free). + -- We skip using this scheme if we have an object of a volatile + -- type and we do not have Name_Req set true (see comments for + -- Side_Effect_Free). - and then (Name_Req or else not Treat_As_Volatile (Exp_Type)) + and then (Name_Req or else not Treat_As_Volatile (Exp_Type))) then Def_Id := Build_Temporary (Loc, 'R', Exp); Res := New_Occurrence_Of (Def_Id, Loc); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index ab6c2c6e536..c0998a5be66 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -4451,7 +4451,9 @@ package body Sem_Attr is -- Has_Same_Storage -- ---------------------- - when Attribute_Has_Same_Storage => + when Attribute_Has_Same_Storage + | Attribute_Overlaps_Storage + => Check_E1; -- The arguments must be objects of any type @@ -5563,21 +5565,6 @@ package body Sem_Attr is end if; end Old; - ---------------------- - -- Overlaps_Storage -- - ---------------------- - - when Attribute_Overlaps_Storage => - Check_E1; - - -- Both arguments must be objects of any type - - Analyze_And_Resolve (P); - Analyze_And_Resolve (E1); - Check_Object_Reference (P); - Check_Object_Reference (E1); - Set_Etype (N, Standard_Boolean); - ------------ -- Output -- ------------ diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 4d678415c5a..f1fd9b2ba28 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -1361,36 +1361,15 @@ package body Sem_Prag is when E_Generic_In_Out_Parameter | E_In_Out_Parameter + | E_Out_Parameter | E_Variable => - -- When pragma Global is present it determines the mode of - -- the object. - - if Global_Seen then - - -- A variable has mode IN when its type is unconstrained - -- or tagged because array bounds, discriminants or tags - -- can be read. - - Item_Is_Input := - Appears_In (Subp_Inputs, Item_Id) - or else Is_Unconstrained_Or_Tagged_Item (Item_Id); - - Item_Is_Output := Appears_In (Subp_Outputs, Item_Id); - - -- Otherwise the variable has a default IN OUT mode - - else - Item_Is_Input := True; - Item_Is_Output := True; - end if; - - when E_Out_Parameter => - -- An OUT parameter of the related subprogram; it cannot -- appear in Global. - if Scope (Item_Id) = Spec_Id then + if Adjusted_Kind = E_Out_Parameter + and then Scope (Item_Id) = Spec_Id + then -- The parameter has mode IN if its type is unconstrained -- or tagged because array bounds, discriminants or tags @@ -1401,8 +1380,8 @@ package body Sem_Prag is Item_Is_Output := True; - -- An OUT parameter of an enclosing subprogram; it can - -- appear in Global and behaves as a read-write variable. + -- A parameter of an enclosing subprogram; it can appear + -- in Global and behaves as a read-write variable. else -- When pragma Global is present it determines the mode @@ -1411,8 +1390,8 @@ package body Sem_Prag is if Global_Seen then -- A variable has mode IN when its type is - -- unconstrained or tagged because array - -- bounds, discriminants or tags can be read. + -- unconstrained or tagged because array bounds, + -- discriminants, or tags can be read. Item_Is_Input := Appears_In (Subp_Inputs, Item_Id) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index addad83c6ae..1b0b39befae 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -798,44 +798,30 @@ package body Sem_Util is -- in effect we treat discriminant components as regular -- components. - elsif Nkind (E) = N_Selected_Component - and then Ekind (Etype (E)) = E_Anonymous_Access_Type - and then Ekind (Etype (Pre)) /= E_Anonymous_Access_Type - and then (not (Nkind (Selector_Name (E)) in N_Has_Entity - and then Ekind (Entity (Selector_Name (E))) - = E_Discriminant) - - -- The alternative accessibility models both treat - -- discriminants as regular components. - - or else (No_Dynamic_Accessibility_Checks_Enabled (E) - and then Allow_Alt_Model)) - then - -- When restriction No_Dynamic_Accessibility_Checks is active - -- and -gnatd_b set, the level is that of the designated type. - - if Allow_Alt_Model - and then No_Dynamic_Accessibility_Checks_Enabled (E) - and then Debug_Flag_Underscore_B - then - return Make_Level_Literal - (Typ_Access_Level (Etype (E))); - end if; + elsif + (Nkind (E) = N_Selected_Component + and then Ekind (Etype (E)) = E_Anonymous_Access_Type + and then Ekind (Etype (Pre)) /= E_Anonymous_Access_Type + and then (not (Nkind (Selector_Name (E)) in N_Has_Entity + and then Ekind (Entity (Selector_Name (E))) + = E_Discriminant) - -- Otherwise proceed normally + -- The alternative accessibility models both treat + -- discriminants as regular components. - return Make_Level_Literal - (Typ_Access_Level (Etype (Prefix (E)))); + or else (No_Dynamic_Accessibility_Checks_Enabled (E) + and then Allow_Alt_Model))) - -- Similar to the previous case - arrays featuring components of - -- anonymous access components get their corresponding level from - -- their containing type's declaration. + -- Arrays featuring components of anonymous access components + -- get their corresponding level from their containing type's + -- declaration. - elsif Nkind (E) = N_Indexed_Component - and then Ekind (Etype (E)) = E_Anonymous_Access_Type - and then Ekind (Etype (Pre)) in Array_Kind - and then Ekind (Component_Type (Base_Type (Etype (Pre)))) - = E_Anonymous_Access_Type + or else + (Nkind (E) = N_Indexed_Component + and then Ekind (Etype (E)) = E_Anonymous_Access_Type + and then Ekind (Etype (Pre)) in Array_Kind + and then Ekind (Component_Type (Base_Type (Etype (Pre)))) + = E_Anonymous_Access_Type) then -- When restriction No_Dynamic_Accessibility_Checks is active -- and -gnatd_b set, the level is that of the designated type. diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 67861ba31de..42a6e4f8ff6 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -3132,7 +3132,9 @@ package body Sprint is when N_Real_Literal => Write_Ureal_With_Col_Check_Sloc (Realval (Node)); - when N_Real_Range_Specification => + when N_Real_Range_Specification + | N_Signed_Integer_Type_Definition + => Write_Str_With_Col_Check_Sloc ("range "); Sprint_Node (Low_Bound (Node)); Write_Str (" .. "); @@ -3248,12 +3250,6 @@ package body Sprint is Write_Indent_Str ("end select;"); - when N_Signed_Integer_Type_Definition => - Write_Str_With_Col_Check_Sloc ("range "); - Sprint_Node (Low_Bound (Node)); - Write_Str (" .. "); - Sprint_Node (High_Bound (Node)); - when N_Single_Protected_Declaration => Write_Indent_Str_Sloc ("protected "); Write_Id (Defining_Identifier (Node));