From 980f94b75b8ccd47afa55c6109a5899f325a61ee Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Tue, 17 Jul 2018 08:06:24 +0000 Subject: [PATCH] [Ada] New ignored Ghost code removal mechanism This patch reimplements the mechanism which removes ignored Ghost code from the tree. The previous mechanism proved to be unreliable because it assumed that no new scoping constructs would be created after some ignored Ghost code had already notified its enclosing scoping constructs that they contain such code. The assumption can be broken by having a call to an ignored Ghost procedure within the extended return statement of a function. The procedure call would signal the enclosing function that it contains ignored Ghost code, however the return statement would introduce an extra block, effectively hiding the procedure call from the ignored Ghost code elimination pass. The new mechanism implemented in this patch forgoes directed tree pruning in favor of storing the actual ignored Ghost code, and later directly eliminating it from the tree. For this approach to operate efficiently, only "top level" ignored Ghost constructs are stored. The top level constructs are essentially nodes which can appear within a declarative or statement list and be safely rewritten into null statements. This ensures that only "root" ignored Ghost construct need to be processed, as opposed to all ignored Ghost nodes within a subtree. The approach has one drawback however. Due to the generation and analysis of ignored Ghost code, a construct may be recorded multiple times (usually twice). The mechanism simply deals with this artefact instead of employing expensive solutions such as hash tables or a common flag shared by all nodes to eliminate the duplicates. ------------ -- Source -- ------------ -- main.adb with Ada.Text_IO; use Ada.Text_IO; procedure Main is procedure Ghost_Proc with Ghost; procedure Ghost_Proc is begin Put_Line ("ERROR: Ghost_Proc called"); end Ghost_Proc; function Func return Integer is begin return Res : Integer := 123 do Ghost_Proc; end return; end Func; Val : Integer with Ghost; begin Val := Func; end Main; ---------------------------- -- Compilation and output -- ---------------------------- $ gcc -c -gnatDG main.adb $ grep -c "ghost" main.adb.dg 0 2018-07-17 Hristian Kirtchev gcc/ada/ * alloc.ads: Update the allocation metrics of the ignored Ghost nodes table. * atree.adb: Add a soft link for a procedure which is invoked whenever an ignored Ghost node or entity is created. (Change_Node): Preserve relevant attributes which come from the Flags table. (Mark_New_Ghost_Node): Record a newly created ignored Ghost node or entity. (Rewrite): Preserve relevant attributes which come from the Flags table. (Set_Ignored_Ghost_Recording_Proc): New routine. * atree.ads: Define an access-to-suprogram type for a soft link which records a newly created ignored Ghost node or entity. (Set_Ignored_Ghost_Recording_Proc): New routine. * ghost.adb: Remove with and use clause for Lib. Remove table Ignored_Ghost_Units. Add new table Ignored_Ghost_Nodes. (Add_Ignored_Ghost_Unit): Removed. (Initialize): Initialize the table which stores ignored Ghost nodes. Set the soft link which allows Atree.Mark_New_Ghost_Node to record an ignored Ghost node. (Is_Ignored_Ghost_Unit): Use the ultimate original node when checking an eliminated ignored Ghost unit. (Lock): Release and lock the table which stores ignored Ghost nodes. (Mark_And_Set_Ghost_Assignment): Record rather than propagate ignored Ghost nodes. (Mark_And_Set_Ghost_Procedure_Call): Record rather than propagate ignored Ghost nodes. (Mark_Ghost_Clause): Record rather than propagate ignored Ghost nodes. (Mark_Ghost_Declaration_Or_Body): Record rather than propagate ignored Ghost nodes. (Mark_Ghost_Pragma): Record rather than propagate ignored Ghost nodes. (Propagate_Ignored_Ghost_Code): Removed. (Record_Ignored_Ghost_Node): New routine. (Remove_Ignored_Ghost_Code): Reimplemented. (Remove_Ignored_Ghost_Node): New routine. (Ultimate_Original_Node): New routine. * ghost.ads (Check_Ghost_Completion): Removed. * sem_ch8.adb (Analyze_Use_Package): Remove obsolete code. Mark a use package clause as ignored Ghost if applicable. * sem_util.adb (Is_Body_Or_Package_Declaration): Reimplemented. From-SVN: r262775 --- gcc/ada/ChangeLog | 43 ++++++ gcc/ada/alloc.ads | 4 +- gcc/ada/atree.adb | 75 ++++++++-- gcc/ada/atree.ads | 7 + gcc/ada/ghost.adb | 348 +++++++++++++++++-------------------------- gcc/ada/ghost.ads | 4 - gcc/ada/sem_ch8.adb | 21 +-- gcc/ada/sem_util.adb | 7 +- 8 files changed, 249 insertions(+), 260 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index db369ccbada..df414ccb5fb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,46 @@ +2018-07-17 Hristian Kirtchev + + * alloc.ads: Update the allocation metrics of the ignored Ghost nodes + table. + * atree.adb: Add a soft link for a procedure which is invoked whenever + an ignored Ghost node or entity is created. + (Change_Node): Preserve relevant attributes which come from the Flags + table. + (Mark_New_Ghost_Node): Record a newly created ignored Ghost node or + entity. + (Rewrite): Preserve relevant attributes which come from the Flags + table. + (Set_Ignored_Ghost_Recording_Proc): New routine. + * atree.ads: Define an access-to-suprogram type for a soft link which + records a newly created ignored Ghost node or entity. + (Set_Ignored_Ghost_Recording_Proc): New routine. + * ghost.adb: Remove with and use clause for Lib. Remove table + Ignored_Ghost_Units. Add new table Ignored_Ghost_Nodes. + (Add_Ignored_Ghost_Unit): Removed. + (Initialize): Initialize the table which stores ignored Ghost nodes. + Set the soft link which allows Atree.Mark_New_Ghost_Node to record an + ignored Ghost node. + (Is_Ignored_Ghost_Unit): Use the ultimate original node when checking + an eliminated ignored Ghost unit. + (Lock): Release and lock the table which stores ignored Ghost nodes. + (Mark_And_Set_Ghost_Assignment): Record rather than propagate ignored + Ghost nodes. + (Mark_And_Set_Ghost_Procedure_Call): Record rather than propagate + ignored Ghost nodes. + (Mark_Ghost_Clause): Record rather than propagate ignored Ghost nodes. + (Mark_Ghost_Declaration_Or_Body): Record rather than propagate ignored + Ghost nodes. + (Mark_Ghost_Pragma): Record rather than propagate ignored Ghost nodes. + (Propagate_Ignored_Ghost_Code): Removed. + (Record_Ignored_Ghost_Node): New routine. + (Remove_Ignored_Ghost_Code): Reimplemented. + (Remove_Ignored_Ghost_Node): New routine. + (Ultimate_Original_Node): New routine. + * ghost.ads (Check_Ghost_Completion): Removed. + * sem_ch8.adb (Analyze_Use_Package): Remove obsolete code. Mark a use + package clause as ignored Ghost if applicable. + * sem_util.adb (Is_Body_Or_Package_Declaration): Reimplemented. + 2018-07-17 Javier Miranda * sem_ch5.adb (Has_Call_Using_Secondary_Stack): Moved to library level diff --git a/gcc/ada/alloc.ads b/gcc/ada/alloc.ads index b2198463253..96e67edd826 100644 --- a/gcc/ada/alloc.ads +++ b/gcc/ada/alloc.ads @@ -67,8 +67,8 @@ package Alloc is In_Out_Warnings_Initial : constant := 100; -- Sem_Warn In_Out_Warnings_Increment : constant := 100; - Ignored_Ghost_Units_Initial : constant := 20; -- Sem_Util - Ignored_Ghost_Units_Increment : constant := 50; + Ignored_Ghost_Nodes_Initial : constant := 100; -- Ghost + Ignored_Ghost_Nodes_Increment : constant := 100; Inlined_Initial : constant := 100; -- Inline Inlined_Increment : constant := 100; diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 958cd5102a9..102d7f6a08a 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -48,6 +48,10 @@ with GNAT.Heap_Sort_G; package body Atree is + Ignored_Ghost_Recording_Proc : Ignored_Ghost_Record_Proc := null; + -- This soft link captures the procedure invoked during the creation of an + -- ignored Ghost node or entity. + Locked : Boolean := False; -- Compiling with assertions enabled, node contents modifications are -- permitted only when this switch is set to False; compiling without @@ -683,12 +687,21 @@ package body Atree is ----------------- procedure Change_Node (N : Node_Id; New_Node_Kind : Node_Kind) is - Save_Sloc : constant Source_Ptr := Sloc (N); + + -- Flags table attributes + + Save_CA : constant Boolean := Flags.Table (N).Check_Actuals; + Save_Is_IGN : constant Boolean := Flags.Table (N).Is_Ignored_Ghost_Node; + + -- Nodes table attributes + + Save_CFS : constant Boolean := Nodes.Table (N).Comes_From_Source; Save_In_List : constant Boolean := Nodes.Table (N).In_List; Save_Link : constant Union_Id := Nodes.Table (N).Link; - Save_CFS : constant Boolean := Nodes.Table (N).Comes_From_Source; Save_Posted : constant Boolean := Nodes.Table (N).Error_Posted; - Par_Count : Nat := 0; + Save_Sloc : constant Source_Ptr := Sloc (N); + + Par_Count : Nat := 0; begin if Nkind (N) in N_Subexpr then @@ -703,7 +716,9 @@ package body Atree is Nodes.Table (N).Nkind := New_Node_Kind; Nodes.Table (N).Error_Posted := Save_Posted; - Flags.Table (N) := Default_Flags; + Flags.Table (N) := Default_Flags; + Flags.Table (N).Check_Actuals := Save_CA; + Flags.Table (N).Is_Ignored_Ghost_Node := Save_Is_IGN; if New_Node_Kind in N_Subexpr then Set_Paren_Count (N, Par_Count); @@ -1606,6 +1621,13 @@ package body Atree is end if; Set_Is_Ignored_Ghost_Node (N); + + -- Record the ignored Ghost node or entity in order to eliminate it + -- from the tree later. + + if Ignored_Ghost_Recording_Proc /= null then + Ignored_Ghost_Recording_Proc.all (N); + end if; end if; end Mark_New_Ghost_Node; @@ -1629,8 +1651,8 @@ package body Atree is if Source > Empty_Or_Error then New_Id := Allocate_Initialize_Node (Source, Has_Extension (Source)); - Nodes.Table (New_Id).Link := Empty_List_Or_Node; Nodes.Table (New_Id).In_List := False; + Nodes.Table (New_Id).Link := Empty_List_Or_Node; -- If the original is marked as a rewrite insertion, then unmark the -- copy, since we inserted the original, not the copy. @@ -2218,16 +2240,24 @@ package body Atree is ------------- procedure Rewrite (Old_Node, New_Node : Node_Id) is - Old_Error_P : constant Boolean := Nodes.Table (Old_Node).Error_Posted; - -- This field is always preserved in the new node - Old_Has_Aspects : constant Boolean := Nodes.Table (Old_Node).Has_Aspects; - -- This field is always preserved in the new node + -- Flags table attributes + + Old_CA : constant Boolean := Flags.Table (Old_Node).Check_Actuals; + Old_Is_IGN : constant Boolean := + Flags.Table (Old_Node).Is_Ignored_Ghost_Node; + + -- Nodes table attributes + + Old_Error_Posted : constant Boolean := + Nodes.Table (Old_Node).Error_Posted; + Old_Has_Aspects : constant Boolean := + Nodes.Table (Old_Node).Has_Aspects; - Old_Paren_Count : Nat; Old_Must_Not_Freeze : Boolean; - -- These fields are preserved in the new node only if the new node - -- and the old node are both subexpression nodes. + Old_Paren_Count : Nat; + -- These fields are preserved in the new node only if the new node and + -- the old node are both subexpression nodes. -- Note: it is a violation of abstraction levels for Must_Not_Freeze -- to be referenced like this. ??? @@ -2244,11 +2274,11 @@ package body Atree is pragma Debug (New_Node_Debugging_Output (New_Node)); if Nkind (Old_Node) in N_Subexpr then - Old_Paren_Count := Paren_Count (Old_Node); Old_Must_Not_Freeze := Must_Not_Freeze (Old_Node); + Old_Paren_Count := Paren_Count (Old_Node); else - Old_Paren_Count := 0; Old_Must_Not_Freeze := False; + Old_Paren_Count := 0; end if; -- Allocate a new node, to be used to preserve the original contents @@ -2274,9 +2304,12 @@ package body Atree is -- Copy substitute node into place, preserving old fields as required Copy_Node (Source => New_Node, Destination => Old_Node); - Nodes.Table (Old_Node).Error_Posted := Old_Error_P; + Nodes.Table (Old_Node).Error_Posted := Old_Error_Posted; Nodes.Table (Old_Node).Has_Aspects := Old_Has_Aspects; + Flags.Table (Old_Node).Check_Actuals := Old_CA; + Flags.Table (Old_Node).Is_Ignored_Ghost_Node := Old_Is_IGN; + if Nkind (New_Node) in N_Subexpr then Set_Paren_Count (Old_Node, Old_Paren_Count); Set_Must_Not_Freeze (Old_Node, Old_Must_Not_Freeze); @@ -2369,6 +2402,18 @@ package body Atree is Nodes.Table (N).Has_Aspects := Val; end Set_Has_Aspects; + -------------------------------------- + -- Set_Ignored_Ghost_Recording_Proc -- + -------------------------------------- + + procedure Set_Ignored_Ghost_Recording_Proc + (Proc : Ignored_Ghost_Record_Proc) + is + begin + pragma Assert (Ignored_Ghost_Recording_Proc = null); + Ignored_Ghost_Recording_Proc := Proc; + end Set_Ignored_Ghost_Recording_Proc; + ------------------------------- -- Set_Is_Ignored_Ghost_Node -- ------------------------------- diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 24d491852ef..b0a0334be4e 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -570,6 +570,13 @@ package Atree is -- are appropriately updated. This function is used only by Sinfo.CN to -- change nodes into their corresponding entities. + type Ignored_Ghost_Record_Proc is access procedure (N : Node_Or_Entity_Id); + + procedure Set_Ignored_Ghost_Recording_Proc + (Proc : Ignored_Ghost_Record_Proc); + -- Register a procedure that is invoked when an ignored Ghost node or + -- entity is created. + type Report_Proc is access procedure (Target : Node_Id; Source : Node_Id); procedure Set_Reporting_Proc (Proc : Report_Proc); diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb index fe566913943..47912aa4685 100644 --- a/gcc/ada/ghost.adb +++ b/gcc/ada/ghost.adb @@ -29,7 +29,6 @@ with Atree; use Atree; with Einfo; use Einfo; with Elists; use Elists; with Errout; use Errout; -with Lib; use Lib; with Namet; use Namet; with Nlists; use Nlists; with Nmake; use Nmake; @@ -50,18 +49,16 @@ package body Ghost is -- Data strictures -- --------------------- - -- The following table contains the N_Compilation_Unit node for a unit that - -- is either subject to pragma Ghost with policy Ignore or contains ignored - -- Ghost code. The table is used in the removal of ignored Ghost code from - -- units. + -- The following table contains all ignored Ghost nodes that must be + -- eliminated from the tree by routine Remove_Ignored_Ghost_Code. - package Ignored_Ghost_Units is new Table.Table ( + package Ignored_Ghost_Nodes is new Table.Table ( Table_Component_Type => Node_Id, Table_Index_Type => Int, Table_Low_Bound => 0, - Table_Initial => Alloc.Ignored_Ghost_Units_Initial, - Table_Increment => Alloc.Ignored_Ghost_Units_Increment, - Table_Name => "Ignored_Ghost_Units"); + Table_Initial => Alloc.Ignored_Ghost_Nodes_Initial, + Table_Increment => Alloc.Ignored_Ghost_Nodes_Increment, + Table_Name => "Ignored_Ghost_Nodes"); ----------------------- -- Local subprograms -- @@ -98,37 +95,9 @@ package body Ghost is -- Convert a Ghost mode denoted by name Mode into its respective enumerated -- value. - procedure Propagate_Ignored_Ghost_Code (N : Node_Id); - -- Signal all enclosing scopes that they now contain at least one ignored - -- Ghost node denoted by N. Add the compilation unit containing N to table - -- Ignored_Ghost_Units for post processing. - - ---------------------------- - -- Add_Ignored_Ghost_Unit -- - ---------------------------- - - procedure Add_Ignored_Ghost_Unit (Unit : Node_Id) is - begin - pragma Assert (Nkind (Unit) = N_Compilation_Unit); - - -- Avoid duplicates in the table as pruning the same unit more than once - -- is wasteful. Since ignored Ghost code tends to be grouped up, check - -- the contents of the table in reverse. - - for Index in reverse Ignored_Ghost_Units.First .. - Ignored_Ghost_Units.Last - loop - -- If the unit is already present in the table, do not add it again - - if Unit = Ignored_Ghost_Units.Table (Index) then - return; - end if; - end loop; - - -- If we get here, then this is the first time the unit is being added - - Ignored_Ghost_Units.Append (Unit); - end Add_Ignored_Ghost_Unit; + procedure Record_Ignored_Ghost_Node (N : Node_Or_Entity_Id); + -- Save ignored Ghost node or entity N in table Ignored_Ghost_Nodes for + -- later elimination. ---------------------------- -- Check_Ghost_Completion -- @@ -913,7 +882,12 @@ package body Ghost is procedure Initialize is begin - Ignored_Ghost_Units.Init; + Ignored_Ghost_Nodes.Init; + + -- Set the soft link which enables Atree.Mark_New_Ghost_Node to record + -- an ignored Ghost node or entity. + + Set_Ignored_Ghost_Recording_Proc (Record_Ignored_Ghost_Node'Access); end Initialize; ------------------------ @@ -1030,6 +1004,28 @@ package body Ghost is --------------------------- function Is_Ignored_Ghost_Unit (N : Node_Id) return Boolean is + function Ultimate_Original_Node (Nod : Node_Id) return Node_Id; + -- Obtain the original node of arbitrary node Nod following a potential + -- chain of rewritings. + + ---------------------------- + -- Ultimate_Original_Node -- + ---------------------------- + + function Ultimate_Original_Node (Nod : Node_Id) return Node_Id is + Res : Node_Id; + + begin + Res := Nod; + while Original_Node (Res) /= Res loop + Res := Original_Node (Res); + end loop; + + return Res; + end Ultimate_Original_Node; + + -- Start of processing for Is_Ignored_Ghost_Unit + begin -- Inspect the original node of the unit in case removal of ignored -- Ghost code has already taken place. @@ -1037,7 +1033,7 @@ package body Ghost is return Nkind (N) = N_Compilation_Unit and then Is_Ignored_Ghost_Entity - (Defining_Entity (Original_Node (Unit (N)))); + (Defining_Entity (Ultimate_Original_Node (Unit (N)))); end Is_Ignored_Ghost_Unit; ------------------------- @@ -1176,8 +1172,8 @@ package body Ghost is procedure Lock is begin - Ignored_Ghost_Units.Release; - Ignored_Ghost_Units.Locked := True; + Ignored_Ghost_Nodes.Release; + Ignored_Ghost_Nodes.Locked := True; end Lock; ----------------------------------- @@ -1201,7 +1197,7 @@ package body Ghost is Install_Ghost_Region (Ignore, N); Set_Is_Ignored_Ghost_Node (N); - Propagate_Ignored_Ghost_Code (N); + Record_Ignored_Ghost_Node (N); end if; end if; end Mark_And_Set_Ghost_Assignment; @@ -1472,11 +1468,39 @@ package body Ghost is Install_Ghost_Region (Ignore, N); Set_Is_Ignored_Ghost_Node (N); - Propagate_Ignored_Ghost_Code (N); + Record_Ignored_Ghost_Node (N); end if; end if; end Mark_And_Set_Ghost_Procedure_Call; + ----------------------- + -- Mark_Ghost_Clause -- + ----------------------- + + procedure Mark_Ghost_Clause (N : Node_Id) is + Nam : Node_Id := Empty; + + begin + if Nkind (N) = N_Use_Package_Clause then + Nam := Name (N); + + elsif Nkind (N) = N_Use_Type_Clause then + Nam := Subtype_Mark (N); + + elsif Nkind (N) = N_With_Clause then + Nam := Name (N); + end if; + + if Present (Nam) + and then Is_Entity_Name (Nam) + and then Present (Entity (Nam)) + and then Is_Ignored_Ghost_Entity (Entity (Nam)) + then + Set_Is_Ignored_Ghost_Node (N); + Record_Ignored_Ghost_Node (N); + end if; + end Mark_Ghost_Clause; + ------------------------------------ -- Mark_Ghost_Declaration_Or_Body -- ------------------------------------ @@ -1502,7 +1526,7 @@ package body Ghost is Mark_Formals := True; Set_Is_Ignored_Ghost_Entity (Id); Set_Is_Ignored_Ghost_Node (N); - Propagate_Ignored_Ghost_Code (N); + Record_Ignored_Ghost_Node (N); end if; -- Mark all formal parameters when the related node denotes a subprogram @@ -1537,34 +1561,6 @@ package body Ghost is end if; end Mark_Ghost_Declaration_Or_Body; - ----------------------- - -- Mark_Ghost_Clause -- - ----------------------- - - procedure Mark_Ghost_Clause (N : Node_Id) is - Nam : Node_Id := Empty; - - begin - if Nkind (N) = N_Use_Package_Clause then - Nam := Name (N); - - elsif Nkind (N) = N_Use_Type_Clause then - Nam := Subtype_Mark (N); - - elsif Nkind (N) = N_With_Clause then - Nam := Name (N); - end if; - - if Present (Nam) - and then Is_Entity_Name (Nam) - and then Present (Entity (Nam)) - and then Is_Ignored_Ghost_Entity (Entity (Nam)) - then - Set_Is_Ignored_Ghost_Node (N); - Propagate_Ignored_Ghost_Code (N); - end if; - end Mark_Ghost_Clause; - ----------------------- -- Mark_Ghost_Pragma -- ----------------------- @@ -1583,7 +1579,7 @@ package body Ghost is elsif Is_Ignored_Ghost_Entity (Id) then Set_Is_Ignored_Ghost_Pragma (N); Set_Is_Ignored_Ghost_Node (N); - Propagate_Ignored_Ghost_Code (N); + Record_Ignored_Ghost_Node (N); end if; end Mark_Ghost_Pragma; @@ -1635,168 +1631,90 @@ package body Ghost is end if; end Name_To_Ghost_Mode; - ---------------------------------- - -- Propagate_Ignored_Ghost_Code -- - ---------------------------------- - - procedure Propagate_Ignored_Ghost_Code (N : Node_Id) is - Nod : Node_Id; - Scop : Entity_Id; + ------------------------------- + -- Record_Ignored_Ghost_Node -- + ------------------------------- + procedure Record_Ignored_Ghost_Node (N : Node_Or_Entity_Id) is begin - -- Traverse the parent chain looking for blocks, packages, and - -- subprograms or their respective bodies. - - Nod := Parent (N); - while Present (Nod) loop - Scop := Empty; - - if Nkind (Nod) = N_Block_Statement - and then Present (Identifier (Nod)) - then - Scop := Entity (Identifier (Nod)); - - elsif Nkind_In (Nod, N_Package_Body, - N_Package_Declaration, - N_Subprogram_Body, - N_Subprogram_Declaration) - then - Scop := Defining_Entity (Nod); - end if; - - -- The current node denotes a scoping construct - - if Present (Scop) then - - -- Stop the traversal when the scope already contains ignored - -- Ghost code as all enclosing scopes have already been marked. - - if Contains_Ignored_Ghost_Code (Scop) then - exit; - - -- Otherwise mark this scope and keep climbing - - else - Set_Contains_Ignored_Ghost_Code (Scop); - end if; - end if; - - Nod := Parent (Nod); - end loop; - - -- The unit containing the ignored Ghost code must be post processed - -- before invoking the back end. + -- Save all "top level" ignored Ghost nodes which can be safely replaced + -- with a null statement. Note that there is need to save other kinds of + -- nodes because those will always be enclosed by some top level ignored + -- Ghost node. + + if Is_Body (N) + or else Is_Declaration (N) + or else Nkind (N) in N_Generic_Instantiation + or else Nkind (N) in N_Push_Pop_xxx_Label + or else Nkind (N) in N_Raise_xxx_Error + or else Nkind (N) in N_Representation_Clause + or else Nkind_In (N, N_Assignment_Statement, + N_Call_Marker, + N_Freeze_Entity, + N_Freeze_Generic_Entity, + N_Itype_Reference, + N_Pragma, + N_Procedure_Call_Statement, + N_Use_Package_Clause, + N_Use_Type_Clause, + N_Variable_Reference_Marker, + N_With_Clause) + then + -- Only ignored Ghost nodes must be recorded in the table - Add_Ignored_Ghost_Unit (Cunit (Get_Code_Unit (N))); - end Propagate_Ignored_Ghost_Code; + pragma Assert (Is_Ignored_Ghost_Node (N)); + Ignored_Ghost_Nodes.Append (N); + end if; + end Record_Ignored_Ghost_Node; ------------------------------- -- Remove_Ignored_Ghost_Code -- ------------------------------- procedure Remove_Ignored_Ghost_Code is - procedure Prune_Tree (Root : Node_Id); - -- Remove all code marked as ignored Ghost from the tree of denoted by - -- Root. - - ---------------- - -- Prune_Tree -- - ---------------- - - procedure Prune_Tree (Root : Node_Id) is - procedure Prune (N : Node_Id); - -- Remove a given node from the tree by rewriting it into null - - function Prune_Node (N : Node_Id) return Traverse_Result; - -- Determine whether node N denotes an ignored Ghost construct. If - -- this is the case, rewrite N as a null statement. See the body for - -- special cases. - - ----------- - -- Prune -- - ----------- - - procedure Prune (N : Node_Id) is - begin - -- Destroy any aspects that may be associated with the node - - if Permits_Aspect_Specifications (N) and then Has_Aspects (N) then - Remove_Aspects (N); - end if; - - Rewrite (N, Make_Null_Statement (Sloc (N))); - end Prune; - - ---------------- - -- Prune_Node -- - ---------------- - - function Prune_Node (N : Node_Id) return Traverse_Result is - Id : Entity_Id; - - begin - -- Do not prune compilation unit nodes because many mechanisms - -- depend on their presence. Note that context items are still - -- being processed. + procedure Remove_Ignored_Ghost_Node (N : Node_Id); + -- Eliminate ignored Ghost node N from the tree - if Nkind (N) = N_Compilation_Unit then - return OK; + ------------------------------- + -- Remove_Ignored_Ghost_Node -- + ------------------------------- - -- The node is either declared as ignored Ghost or is a byproduct - -- of expansion. Destroy it and stop the traversal on this branch. - - elsif Is_Ignored_Ghost_Node (N) then - Prune (N); - return Skip; - - -- Scoping constructs such as blocks, packages, subprograms and - -- bodies offer some flexibility with respect to pruning. - - elsif Nkind_In (N, N_Block_Statement, - N_Package_Body, - N_Package_Declaration, - N_Subprogram_Body, - N_Subprogram_Declaration) - then - if Nkind (N) = N_Block_Statement then - Id := Entity (Identifier (N)); - else - Id := Defining_Entity (N); - end if; - - -- The scoping construct contains both living and ignored Ghost - -- code, let the traversal prune all relevant nodes. + procedure Remove_Ignored_Ghost_Node (N : Node_Id) is + begin + -- The generation and processing of ignored Ghost nodes may cause the + -- same node to be saved multiple times. Reducing the number of saves + -- to one involves costly solutions such as a hash table or the use + -- of a flag shared by all nodes. To solve this problem, the removal + -- machinery allows for multiple saves, but does not eliminate a node + -- which has already been eliminated. - if Contains_Ignored_Ghost_Code (Id) then - return OK; + if Nkind (N) = N_Null_Statement then + null; - -- Otherwise the construct contains only living code and should - -- not be pruned. + -- Otherwise the ignored Ghost node must be eliminated - else - return Skip; - end if; + else + -- Only ignored Ghost nodes must be eliminated from the tree - -- Otherwise keep searching for ignored Ghost nodes + pragma Assert (Is_Ignored_Ghost_Node (N)); - else - return OK; - end if; - end Prune_Node; + -- Eliminate the node by rewriting it into null. Another option + -- is to remove it from the tree, however multiple corner cases + -- emerge which have be dealt individually. - procedure Prune_Nodes is new Traverse_Proc (Prune_Node); + Rewrite (N, Make_Null_Statement (Sloc (N))); - -- Start of processing for Prune_Tree + -- Eliminate any aspects hanging off the ignored Ghost node - begin - Prune_Nodes (Root); - end Prune_Tree; + Remove_Aspects (N); + end if; + end Remove_Ignored_Ghost_Node; -- Start of processing for Remove_Ignored_Ghost_Code begin - for Index in Ignored_Ghost_Units.First .. Ignored_Ghost_Units.Last loop - Prune_Tree (Ignored_Ghost_Units.Table (Index)); + for Index in Ignored_Ghost_Nodes.First .. Ignored_Ghost_Nodes.Last loop + Remove_Ignored_Ghost_Node (Ignored_Ghost_Nodes.Table (Index)); end loop; end Remove_Ignored_Ghost_Code; diff --git a/gcc/ada/ghost.ads b/gcc/ada/ghost.ads index ef951167590..c079595f6c5 100644 --- a/gcc/ada/ghost.ads +++ b/gcc/ada/ghost.ads @@ -31,10 +31,6 @@ with Types; use Types; package Ghost is - procedure Add_Ignored_Ghost_Unit (Unit : Node_Id); - -- Add a single ignored Ghost compilation unit to the internal table for - -- post processing. - procedure Check_Ghost_Completion (Prev_Id : Entity_Id; Compl_Id : Entity_Id); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 830aa038b21..f5381447b32 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3782,9 +3782,7 @@ package body Sem_Ch8 is -- Local variables - Ghost_Id : Entity_Id := Empty; - Living_Id : Entity_Id := Empty; - Pack : Entity_Id; + Pack : Entity_Id; -- Start of processing for Analyze_Use_Package @@ -3870,22 +3868,9 @@ package body Sem_Ch8 is end if; Use_One_Package (N, Name (N)); - - -- Capture the first Ghost package and the first living package - - if Is_Entity_Name (Name (N)) then - Pack := Entity (Name (N)); - - if Is_Ghost_Entity (Pack) then - if No (Ghost_Id) then - Ghost_Id := Pack; - end if; - - elsif No (Living_Id) then - Living_Id := Pack; - end if; - end if; end if; + + Mark_Ghost_Clause (N); end Analyze_Use_Package; ---------------------- diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index fa24d4a39be..bc44cd35dcc 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -13401,12 +13401,7 @@ package body Sem_Util is function Is_Body_Or_Package_Declaration (N : Node_Id) return Boolean is begin - return Nkind_In (N, N_Entry_Body, - N_Package_Body, - N_Package_Declaration, - N_Protected_Body, - N_Subprogram_Body, - N_Task_Body); + return Is_Body (N) or else Nkind (N) = N_Package_Declaration; end Is_Body_Or_Package_Declaration; ----------------------- -- 2.30.2