From patchwork Thu Jun 17 14:33:10 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 1493556 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4G5PlY5Sf1z9sSs for ; Fri, 18 Jun 2021 00:37:13 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 0922B394504C for ; Thu, 17 Jun 2021 14:37:11 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from rock.gnat.com (rock.gnat.com [205.232.38.15]) by sourceware.org (Postfix) with ESMTPS id BC1A23945C2D for ; Thu, 17 Jun 2021 14:33:10 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org BC1A23945C2D Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 97762117B31; Thu, 17 Jun 2021 10:33:10 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id US5GPylPgFYU; Thu, 17 Jun 2021 10:33:10 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 80353116C9F; Thu, 17 Jun 2021 10:33:10 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 7F3ECA3; Thu, 17 Jun 2021 10:33:10 -0400 (EDT) Date: Thu, 17 Jun 2021 10:33:10 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Subject: [Ada] Fix varsize node name conflict Message-ID: <20210617143310.GA8703@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-12.6 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) 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: , Cc: Bob Duff Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" The enumeration literals in type Node_Field were overloading the getter functions, which causes gdb to be confused. Same for Entity_Field. This patch prefixes all the enumeration literals with "F_", to disambiguate. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * gen_il-gen.adb, gen_il-internals.ads: Generate field enumeration literals with "F_" prefix. Update all generated references accordingly. * atree.adb, einfo-utils.adb, sem_ch3.adb, sem_ch5.adb, sem_ch6.adb, sem_ch8.adb, sinfo-cn.adb, sinfo-utils.adb, sinfo-utils.ads, treepr.adb: Add "F_" prefix to all uses of the field enumeration literals. diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -900,12 +900,12 @@ package body Atree is end Check_Vanishing_Fields; Nkind_Offset : constant Field_Offset := - Node_Field_Descriptors (Nkind).Offset; + Node_Field_Descriptors (F_Nkind).Offset; procedure Set_Node_Kind_Type is new Set_8_Bit_Field (Node_Kind) with Inline; procedure Init_Nkind (N : Node_Id; Val : Node_Kind) is - pragma Assert (Field_Is_Initial_Zero (N, Nkind)); + pragma Assert (Field_Is_Initial_Zero (N, F_Nkind)); begin Set_Node_Kind_Type (N, Nkind_Offset, Val); end Init_Nkind; @@ -953,7 +953,7 @@ package body Atree is end Mutate_Nkind; Ekind_Offset : constant Field_Offset := - Entity_Field_Descriptors (Ekind).Offset; + Entity_Field_Descriptors (F_Ekind).Offset; procedure Set_Entity_Kind_Type is new Set_8_Bit_Field (Entity_Kind) with Inline; @@ -1323,11 +1323,11 @@ package body Atree is -- we can't just call Set_Chars, because Empty is of the wrong -- type, and is outside the range of Name_Id. - Reinit_Field_To_Zero (New_Id, Chars); - Reinit_Field_To_Zero (New_Id, Has_Private_View); - Reinit_Field_To_Zero (New_Id, Is_Elaboration_Checks_OK_Node); - Reinit_Field_To_Zero (New_Id, Is_Elaboration_Warnings_OK_Node); - Reinit_Field_To_Zero (New_Id, Is_SPARK_Mode_On_Node); + Reinit_Field_To_Zero (New_Id, F_Chars); + Reinit_Field_To_Zero (New_Id, F_Has_Private_View); + Reinit_Field_To_Zero (New_Id, F_Is_Elaboration_Checks_OK_Node); + Reinit_Field_To_Zero (New_Id, F_Is_Elaboration_Warnings_OK_Node); + Reinit_Field_To_Zero (New_Id, F_Is_SPARK_Mode_On_Node); -- Change the node type diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb --- a/gcc/ada/einfo-utils.adb +++ b/gcc/ada/einfo-utils.adb @@ -2676,7 +2676,7 @@ package body Einfo.Utils is function Scope_Depth_Set (Id : E) return B is begin return not Is_Record_Type (Id) - and then not Field_Is_Initial_Zero (Id, Scope_Depth_Value); + and then not Field_Is_Initial_Zero (Id, F_Scope_Depth_Value); -- We can't call Scope_Depth_Value here, because Empty is not a valid -- value of type Uint. end Scope_Depth_Set; diff --git a/gcc/ada/gen_il-gen.adb b/gcc/ada/gen_il-gen.adb --- a/gcc/ada/gen_il-gen.adb +++ b/gcc/ada/gen_il-gen.adb @@ -2019,7 +2019,7 @@ package body Gen_IL.Gen is Put (S, ",\n"); end if; - Put (S, "\1", Image (F)); + Put (S, "\1", F_Image (F)); end if; end loop; end Put_Field_Array; @@ -2081,7 +2081,7 @@ package body Gen_IL.Gen is Put (S, ",\n"); end if; - Put (S, "\1", Image (F)); + Put (S, "\1", F_Image (F)); end loop; Outdent (S, 1); @@ -2161,7 +2161,7 @@ package body Gen_IL.Gen is Put (S, ",\n"); end if; - Put (S, "\1 => (\2_Field, \3)", Image (F), + Put (S, "\1 => (\2_Field, \3)", F_Image (F), Image (Field_Table (F).Field_Type), Image (Field_Table (F).Offset)); end loop; @@ -2283,6 +2283,8 @@ package body Gen_IL.Gen is Put (B, "end Set_\1_Id_With_Parent;\n", Kind); end Put_Setter_With_Parent; + -- Start of processing for Put_Nodes + begin Put (S, "with Seinfo; use Seinfo;\n"); Put (S, "pragma Warnings (Off);\n"); diff --git a/gcc/ada/gen_il-internals.ads b/gcc/ada/gen_il-internals.ads --- a/gcc/ada/gen_il-internals.ads +++ b/gcc/ada/gen_il-internals.ads @@ -189,6 +189,13 @@ package Gen_IL.Internals is function Image (F : Opt_Field_Enum) return String; + function F_Image (F : Opt_Field_Enum) return String is + ("F_" & Image (F)); + -- Prepends "F_" to Image (F). This is used for the enumeration literals in + -- the generated Sinfo.Nodes.Node_Field and Einfo.Entities.Entity_Field + -- types. If we used Image (F), these enumeration literals would overload + -- the getter functions, which confuses gdb. + procedure Nil (T : Node_Or_Entity_Type); -- Null procedure diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4760,7 +4760,7 @@ package body Sem_Ch3 is -- Now establish the proper kind and type of the object if Ekind (Id) = E_Void then - Reinit_Field_To_Zero (Id, Next_Inlined_Subprogram); + Reinit_Field_To_Zero (Id, F_Next_Inlined_Subprogram); end if; if Constant_Present (N) then @@ -6181,7 +6181,7 @@ package body Sem_Ch3 is if Nkind (Def) = N_Constrained_Array_Definition then if Ekind (T) in Incomplete_Or_Private_Kind then - Reinit_Field_To_Zero (T, Stored_Constraint); + Reinit_Field_To_Zero (T, F_Stored_Constraint); else pragma Assert (Ekind (T) = E_Void); end if; @@ -6228,7 +6228,7 @@ package body Sem_Ch3 is else pragma Assert (Nkind (Def) = N_Unconstrained_Array_Definition); if Ekind (T) in Incomplete_Or_Private_Kind then - Reinit_Field_To_Zero (T, Stored_Constraint); + Reinit_Field_To_Zero (T, F_Stored_Constraint); else pragma Assert (Ekind (T) = E_Void); end if; @@ -9747,7 +9747,7 @@ package body Sem_Ch3 is if Ekind (Derived_Type) in Incomplete_Or_Private_Kind and then Ekind (Parent_Base) in Modular_Integer_Kind | Array_Kind then - Reinit_Field_To_Zero (Derived_Type, Stored_Constraint); + Reinit_Field_To_Zero (Derived_Type, F_Stored_Constraint); end if; Set_Scope (Derived_Type, Current_Scope); @@ -12532,7 +12532,7 @@ package body Sem_Ch3 is Set_Associated_Node_For_Itype (Full, Related_Nod); if Ekind (Full) in Incomplete_Or_Private_Kind then - Reinit_Field_To_Zero (Full, Private_Dependents); + Reinit_Field_To_Zero (Full, F_Private_Dependents); end if; -- Set common attributes for all subtypes: kind, convention, etc. @@ -19225,19 +19225,19 @@ package body Sem_Ch3 is -- cannot have any invariants. if Ekind (CW_Type) in Incomplete_Or_Private_Kind then - Reinit_Field_To_Zero (CW_Type, Private_Dependents); + Reinit_Field_To_Zero (CW_Type, F_Private_Dependents); elsif Ekind (CW_Type) in Concurrent_Kind then - Reinit_Field_To_Zero (CW_Type, First_Private_Entity); - Reinit_Field_To_Zero (CW_Type, Scope_Depth_Value); + Reinit_Field_To_Zero (CW_Type, F_First_Private_Entity); + Reinit_Field_To_Zero (CW_Type, F_Scope_Depth_Value); if Ekind (CW_Type) in Task_Kind then - Reinit_Field_To_Zero (CW_Type, Is_Elaboration_Checks_OK_Id); - Reinit_Field_To_Zero (CW_Type, Is_Elaboration_Warnings_OK_Id); + Reinit_Field_To_Zero (CW_Type, F_Is_Elaboration_Checks_OK_Id); + Reinit_Field_To_Zero (CW_Type, F_Is_Elaboration_Warnings_OK_Id); end if; if Ekind (CW_Type) in E_Task_Type | E_Protected_Type then - Reinit_Field_To_Zero (CW_Type, SPARK_Aux_Pragma_Inherited); + Reinit_Field_To_Zero (CW_Type, F_SPARK_Aux_Pragma_Inherited); end if; end if; @@ -19624,7 +19624,7 @@ package body Sem_Ch3 is Analyze_And_Resolve (Mod_Expr, Any_Integer); if Ekind (T) in Incomplete_Or_Private_Kind then - Reinit_Field_To_Zero (T, Stored_Constraint); + Reinit_Field_To_Zero (T, F_Stored_Constraint); end if; Set_Etype (T, T); @@ -20428,7 +20428,7 @@ package body Sem_Ch3 is Id := Defining_Identifier (Discr); if Ekind (Id) = E_In_Parameter then - Reinit_Field_To_Zero (Id, Discriminal_Link); + Reinit_Field_To_Zero (Id, F_Discriminal_Link); end if; Mutate_Ekind (Id, E_Discriminant); @@ -21316,7 +21316,7 @@ package body Sem_Ch3 is Set_Subtype_Indication (Parent (Priv_Dep), New_Occurrence_Of (Full_T, Sloc (Priv_Dep))); Reinit_Field_To_Zero - (Priv_Dep, Private_Dependents, + (Priv_Dep, F_Private_Dependents, Old_Ekind => E_Incomplete_Subtype); Mutate_Ekind (Priv_Dep, Subtype_Kind (Ekind (Full_T))); Set_Etype (Priv_Dep, Full_T); diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1320,7 +1320,7 @@ package body Sem_Ch5 is else if Ekind (Ent) = E_Label then - Reinit_Field_To_Zero (Ent, Enclosing_Scope); + Reinit_Field_To_Zero (Ent, F_Enclosing_Scope); end if; Mutate_Ekind (Ent, E_Block); @@ -3760,7 +3760,7 @@ package body Sem_Ch5 is -- parser for generic units. if Ekind (Ent) = E_Label then - Reinit_Field_To_Zero (Ent, Enclosing_Scope); + Reinit_Field_To_Zero (Ent, F_Enclosing_Scope); Mutate_Ekind (Ent, E_Loop); if Nkind (Parent (Ent)) = N_Implicit_Label_Declaration then diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1848,7 +1848,7 @@ package body Sem_Ch6 is -- Visible generic entity is callable within its own body Mutate_Ekind (Gen_Id, Ekind (Body_Id)); - Reinit_Field_To_Zero (Body_Id, Has_Out_Or_In_Out_Parameter, + Reinit_Field_To_Zero (Body_Id, F_Has_Out_Or_In_Out_Parameter, Old_Ekind => (E_Function | E_Procedure | E_Generic_Function | E_Generic_Procedure => True, @@ -1929,7 +1929,7 @@ package body Sem_Ch6 is -- Outside of its body, unit is generic again - Reinit_Field_To_Zero (Gen_Id, Has_Nested_Subprogram, + Reinit_Field_To_Zero (Gen_Id, F_Has_Nested_Subprogram, Old_Ekind => (E_Function | E_Procedure => True, others => False)); Mutate_Ekind (Gen_Id, Kind); Generate_Reference (Gen_Id, Body_Id, 'b', Set_Ref => False); @@ -4610,16 +4610,16 @@ package body Sem_Ch6 is Reference_Body_Formals (Spec_Id, Body_Id); end if; - Reinit_Field_To_Zero (Body_Id, Has_Out_Or_In_Out_Parameter); - Reinit_Field_To_Zero (Body_Id, Needs_No_Actuals, + Reinit_Field_To_Zero (Body_Id, F_Has_Out_Or_In_Out_Parameter); + Reinit_Field_To_Zero (Body_Id, F_Needs_No_Actuals, Old_Ekind => (E_Function | E_Procedure => True, others => False)); - Reinit_Field_To_Zero (Body_Id, Is_Predicate_Function, + Reinit_Field_To_Zero (Body_Id, F_Is_Predicate_Function, Old_Ekind => (E_Function | E_Procedure => True, others => False)); - Reinit_Field_To_Zero (Body_Id, Protected_Subprogram, + Reinit_Field_To_Zero (Body_Id, F_Protected_Subprogram, Old_Ekind => (E_Function | E_Procedure => True, others => False)); if Ekind (Body_Id) = E_Procedure then - Reinit_Field_To_Zero (Body_Id, Receiving_Entry); + Reinit_Field_To_Zero (Body_Id, F_Receiving_Entry); end if; Mutate_Ekind (Body_Id, E_Subprogram_Body); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3278,8 +3278,8 @@ package body Sem_Ch8 is -- constructed later at the freeze point, so indicate that the -- completion has not been seen yet. - Reinit_Field_To_Zero (New_S, Has_Out_Or_In_Out_Parameter); - Reinit_Field_To_Zero (New_S, Needs_No_Actuals, + Reinit_Field_To_Zero (New_S, F_Has_Out_Or_In_Out_Parameter); + Reinit_Field_To_Zero (New_S, F_Needs_No_Actuals, Old_Ekind => (E_Function | E_Procedure => True, others => False)); Mutate_Ekind (New_S, E_Subprogram_Body); New_S := Rename_Spec; @@ -6835,7 +6835,7 @@ package body Sem_Ch8 is case Nkind (N) is when N_Selected_Component => - Reinit_Field_To_Zero (N, Is_Prefixed_Call); + Reinit_Field_To_Zero (N, F_Is_Prefixed_Call); Change_Selected_Component_To_Expanded_Name (N); when N_Expanded_Name => diff --git a/gcc/ada/sinfo-cn.adb b/gcc/ada/sinfo-cn.adb --- a/gcc/ada/sinfo-cn.adb +++ b/gcc/ada/sinfo-cn.adb @@ -45,7 +45,7 @@ package body Sinfo.CN is (N : Node_Id) is begin - Reinit_Field_To_Zero (N, Char_Literal_Value); + Reinit_Field_To_Zero (N, F_Char_Literal_Value); Extend_Node (N); end Change_Character_Literal_To_Defining_Character_Literal; @@ -130,7 +130,7 @@ package body Sinfo.CN is (N : Node_Id) is begin - Reinit_Field_To_Zero (N, Strval); + Reinit_Field_To_Zero (N, F_Strval); Extend_Node (N); end Change_Operator_Symbol_To_Defining_Operator_Symbol; @@ -140,7 +140,7 @@ package body Sinfo.CN is procedure Change_Operator_Symbol_To_String_Literal (N : Node_Id) is begin - Reinit_Field_To_Zero (N, Chars); + Reinit_Field_To_Zero (N, F_Chars); Set_Entity (N, Empty); Mutate_Nkind (N, N_String_Literal); end Change_Operator_Symbol_To_String_Literal; diff --git a/gcc/ada/sinfo-utils.adb b/gcc/ada/sinfo-utils.adb --- a/gcc/ada/sinfo-utils.adb +++ b/gcc/ada/sinfo-utils.adb @@ -239,7 +239,7 @@ package body Sinfo.Utils is begin for J in Fields'Range loop - if Fields (J) /= Link then -- Don't walk Parent! + if Fields (J) /= F_Link then -- Don't walk Parent! declare Desc : Field_Descriptor renames Node_Field_Descriptors (Fields (J)); @@ -264,7 +264,7 @@ package body Sinfo.Utils is begin for J in Fields'Range loop - if Fields (J) /= Link then -- Don't walk Parent! + if Fields (J) /= F_Link then -- Don't walk Parent! declare Desc : Field_Descriptor renames Node_Field_Descriptors (Fields (J)); diff --git a/gcc/ada/sinfo-utils.ads b/gcc/ada/sinfo-utils.ads --- a/gcc/ada/sinfo-utils.ads +++ b/gcc/ada/sinfo-utils.ads @@ -139,10 +139,10 @@ package Sinfo.Utils is (N : N_Inclusive_Has_Entity; Val : Node_Id) renames Set_Entity_Or_Associated_Node; - function Associated_Node return Node_Field renames - Entity_Or_Associated_Node; - function Entity return Node_Field renames - Entity_Or_Associated_Node; + function F_Associated_Node return Node_Field renames + F_Entity_Or_Associated_Node; + function F_Entity return Node_Field renames + F_Entity_Or_Associated_Node; -- Note that we are renaming the enumeration literals here --------------- diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -284,110 +284,118 @@ package body Treepr is function Image (F : Node_Field) return String is begin case F is - when Alloc_For_BIP_Return => + when F_Alloc_For_BIP_Return => return "Alloc_For_BIP_Return"; - when Assignment_OK => + when F_Assignment_OK => return "Assignment_OK"; - when Backwards_OK => + when F_Backwards_OK => return "Backwards_OK"; - when Conversion_OK => + when F_Conversion_OK => return "Conversion_OK"; - when Forwards_OK => + when F_Forwards_OK => return "Forwards_OK"; - when Has_SP_Choice => + when F_Has_SP_Choice => return "Has_SP_Choice"; - when Is_Elaboration_Checks_OK_Node => + when F_Is_Elaboration_Checks_OK_Node => return "Is_Elaboration_Checks_OK_Node"; - when Is_Elaboration_Warnings_OK_Node => + when F_Is_Elaboration_Warnings_OK_Node => return "Is_Elaboration_Warnings_OK_Node"; - when Is_Known_Guaranteed_ABE => + when F_Is_Known_Guaranteed_ABE => return "Is_Known_Guaranteed_ABE"; - when Is_SPARK_Mode_On_Node => + when F_Is_SPARK_Mode_On_Node => return "Is_SPARK_Mode_On_Node"; - when Local_Raise_Not_OK => + when F_Local_Raise_Not_OK => return "Local_Raise_Not_OK"; - when SCIL_Controlling_Tag => + when F_SCIL_Controlling_Tag => return "SCIL_Controlling_Tag"; - when SCIL_Entity => + when F_SCIL_Entity => return "SCIL_Entity"; - when SCIL_Tag_Value => + when F_SCIL_Tag_Value => return "SCIL_Tag_Value"; - when SCIL_Target_Prim => + when F_SCIL_Target_Prim => return "SCIL_Target_Prim"; - when Shift_Count_OK => + when F_Shift_Count_OK => return "Shift_Count_OK"; - when Split_PPC => + when F_Split_PPC => return "Split_PPC"; - when TSS_Elist => + when F_TSS_Elist => return "TSS_Elist"; when others => - return Capitalize (F'Img); + declare + Result : constant String := Capitalize (F'Img); + begin + return Result (3 .. Result'Last); -- Remove "F_" + end; end case; end Image; function Image (F : Entity_Field) return String is begin case F is - when BIP_Initialization_Call => + when F_BIP_Initialization_Call => return "BIP_Initialization_Call"; - when Body_Needed_For_SAL => + when F_Body_Needed_For_SAL => return "Body_Needed_For_SAL"; - when CR_Discriminant => + when F_CR_Discriminant => return "CR_Discriminant"; - when DT_Entry_Count => + when F_DT_Entry_Count => return "DT_Entry_Count"; - when DT_Offset_To_Top_Func => + when F_DT_Offset_To_Top_Func => return "DT_Offset_To_Top_Func"; - when DT_Position => + when F_DT_Position => return "DT_Position"; - when DTC_Entity => + when F_DTC_Entity => return "DTC_Entity"; - when Has_Inherited_DIC => + when F_Has_Inherited_DIC => return "Has_Inherited_DIC"; - when Has_Own_DIC => + when F_Has_Own_DIC => return "Has_Own_DIC"; - when Has_RACW => + when F_Has_RACW => return "Has_RACW"; - when Ignore_SPARK_Mode_Pragmas => + when F_Ignore_SPARK_Mode_Pragmas => return "Ignore_SPARK_Mode_Pragmas"; - when Is_Constr_Subt_For_UN_Aliased => + when F_Is_Constr_Subt_For_UN_Aliased => return "Is_Constr_Subt_For_UN_Aliased"; - when Is_CPP_Class => + when F_Is_CPP_Class => return "Is_CPP_Class"; - when Is_CUDA_Kernel => + when F_Is_CUDA_Kernel => return "Is_CUDA_Kernel"; - when Is_DIC_Procedure => + when F_Is_DIC_Procedure => return "Is_DIC_Procedure"; - when Is_Discrim_SO_Function => + when F_Is_Discrim_SO_Function => return "Is_Discrim_SO_Function"; - when Is_Elaboration_Checks_OK_Id => + when F_Is_Elaboration_Checks_OK_Id => return "Is_Elaboration_Checks_OK_Id"; - when Is_Elaboration_Warnings_OK_Id => + when F_Is_Elaboration_Warnings_OK_Id => return "Is_Elaboration_Warnings_OK_Id"; - when Is_RACW_Stub_Type => + when F_Is_RACW_Stub_Type => return "Is_RACW_Stub_Type"; - when OK_To_Rename => + when F_OK_To_Rename => return "OK_To_Rename"; - when Referenced_As_LHS => + when F_Referenced_As_LHS => return "Referenced_As_LHS"; - when RM_Size => + when F_RM_Size => return "RM_Size"; - when SPARK_Aux_Pragma => + when F_SPARK_Aux_Pragma => return "SPARK_Aux_Pragma"; - when SPARK_Aux_Pragma_Inherited => + when F_SPARK_Aux_Pragma_Inherited => return "SPARK_Aux_Pragma_Inherited"; - when SPARK_Pragma => + when F_SPARK_Pragma => return "SPARK_Pragma"; - when SPARK_Pragma_Inherited => + when F_SPARK_Pragma_Inherited => return "SPARK_Pragma_Inherited"; - when SSO_Set_High_By_Default => + when F_SSO_Set_High_By_Default => return "SSO_Set_High_By_Default"; - when SSO_Set_Low_By_Default => + when F_SSO_Set_Low_By_Default => return "SSO_Set_Low_By_Default"; when others => - return Capitalize (F'Img); + declare + Result : constant String := Capitalize (F'Img); + begin + return Result (3 .. Result'Last); -- Remove "F_" + end; end case; end Image; @@ -646,8 +654,8 @@ package body Treepr is Should_Print : constant Entity_Field_Set := -- Set of fields that should be printed. False for fields that were -- already printed above. - (Ekind - | Basic_Convention => False, -- Convention was printed + (F_Ekind + | F_Basic_Convention => False, -- Convention was printed others => True); begin -- Outer loop makes flags come out last @@ -1372,31 +1380,31 @@ package body Treepr is -- Set of fields that should be printed. False for fields that were -- already printed above, and for In_List, which we don't bother -- printing. - (Nkind - | Chars - | Comes_From_Source - | Analyzed - | Error_Posted - | Is_Ignored_Ghost_Node - | Check_Actuals - | Link -- Parent was printed - | Sloc - | Left_Opnd - | Right_Opnd - | Entity - | Assignment_OK - | Do_Range_Check - | Has_Dynamic_Length_Check - | Has_Aspects - | Is_Controlling_Actual - | Is_Overloaded - | Is_Static_Expression - | Must_Not_Freeze - | Small_Paren_Count -- Paren_Count was printed - | Raises_Constraint_Error - | Do_Overflow_Check - | Etype - | In_List + (F_Nkind + | F_Chars + | F_Comes_From_Source + | F_Analyzed + | F_Error_Posted + | F_Is_Ignored_Ghost_Node + | F_Check_Actuals + | F_Link -- Parent was printed + | F_Sloc + | F_Left_Opnd + | F_Right_Opnd + | F_Entity + | F_Assignment_OK + | F_Do_Range_Check + | F_Has_Dynamic_Length_Check + | F_Has_Aspects + | F_Is_Controlling_Actual + | F_Is_Overloaded + | F_Is_Static_Expression + | F_Must_Not_Freeze + | F_Small_Paren_Count -- Paren_Count was printed + | F_Raises_Constraint_Error + | F_Do_Overflow_Check + | F_Etype + | F_In_List => False, others => True); @@ -1415,7 +1423,7 @@ package body Treepr is -- Special case for End_Span, which also prints the -- End_Location. - if Fields (Field_Index) = End_Span then + if Fields (Field_Index) = F_End_Span then Print_End_Span (N); else @@ -2227,7 +2235,7 @@ package body Treepr is -- but what concerns us now is looking for descendants in -- the tree. - and then F /= Next_Entity -- See below for why we skip this + and then F /= F_Next_Entity -- See below for why we skip this then Visit_Descendant (Get_Union_Id (N, FD.Offset)); end if;