------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- G H O S T -- -- -- -- B o d y -- -- -- -- Copyright (C) 2014-2015, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING3. If not, go to -- -- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with Alloc; use Alloc; with Aspects; use Aspects; 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; with Opt; use Opt; with Sem; use Sem; with Sem_Aux; use Sem_Aux; with Sem_Eval; use Sem_Eval; with Sem_Res; use Sem_Res; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; with Snames; use Snames; with Table; package body Ghost is -- 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. package Ignored_Ghost_Units 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"); ----------------------- -- Local Subprograms -- ----------------------- procedure Propagate_Ignored_Ghost_Code (N : Node_Id); -- Subsidiary to Set_Ghost_Mode_xxx. Signal all enclosing scopes that they -- now contain ignored Ghost code. 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; ---------------------------- -- Check_Ghost_Completion -- ---------------------------- procedure Check_Ghost_Completion (Partial_View : Entity_Id; Full_View : Entity_Id) is Policy : constant Name_Id := Policy_In_Effect (Name_Ghost); begin -- The Ghost policy in effect at the point of declaration and at the -- point of completion must match (SPARK RM 6.9(15)). if Is_Checked_Ghost_Entity (Partial_View) and then Policy = Name_Ignore then Error_Msg_Sloc := Sloc (Full_View); Error_Msg_N ("incompatible ghost policies in effect", Partial_View); Error_Msg_N ("\& declared with ghost policy Check", Partial_View); Error_Msg_N ("\& completed # with ghost policy Ignore", Partial_View); elsif Is_Ignored_Ghost_Entity (Partial_View) and then Policy = Name_Check then Error_Msg_Sloc := Sloc (Full_View); Error_Msg_N ("incompatible ghost policies in effect", Partial_View); Error_Msg_N ("\& declared with ghost policy Ignore", Partial_View); Error_Msg_N ("\& completed # with ghost policy Check", Partial_View); end if; end Check_Ghost_Completion; ------------------------- -- Check_Ghost_Context -- ------------------------- procedure Check_Ghost_Context (Ghost_Id : Entity_Id; Ghost_Ref : Node_Id) is procedure Check_Ghost_Policy (Id : Entity_Id; Err_N : Node_Id); -- Verify that the Ghost policy at the point of declaration of entity Id -- matches the policy at the point of reference. If this is not the case -- emit an error at Err_N. function Is_OK_Ghost_Context (Context : Node_Id) return Boolean; -- Determine whether node Context denotes a Ghost-friendly context where -- a Ghost entity can safely reside. ------------------------- -- Is_OK_Ghost_Context -- ------------------------- function Is_OK_Ghost_Context (Context : Node_Id) return Boolean is function Is_Ghost_Declaration (Decl : Node_Id) return Boolean; -- Determine whether node Decl is a Ghost declaration or appears -- within a Ghost declaration. function Is_Ghost_Statement_Or_Pragma (N : Node_Id) return Boolean; -- Determine whether statement or pragma N is Ghost or appears within -- a Ghost statement or pragma. To qualify as such, N must either -- 1) Occur within a ghost subprogram or package -- 2) Denote a call to a ghost procedure -- 3) Denote an assignment statement whose target is a ghost -- variable. -- 4) Denote a pragma that mentions a ghost entity -------------------------- -- Is_Ghost_Declaration -- -------------------------- function Is_Ghost_Declaration (Decl : Node_Id) return Boolean is Par : Node_Id; Subp_Decl : Node_Id; Subp_Id : Entity_Id; begin -- Climb the parent chain looking for an object declaration Par := Decl; while Present (Par) loop if Is_Declaration (Par) then -- A declaration is Ghost when it appears within a Ghost -- package or subprogram. if Ghost_Mode > None then return True; -- Otherwise the declaration may not have been analyzed yet, -- determine whether it is subject to aspect/pragma Ghost. else return Is_Subject_To_Ghost (Par); end if; -- Special cases -- A reference to a Ghost entity may appear as the default -- expression of a formal parameter of a subprogram body. This -- context must be treated as suitable because the relation -- between the spec and the body has not been established and -- the body is not marked as Ghost yet. The real check was -- performed on the spec. elsif Nkind (Par) = N_Parameter_Specification and then Nkind (Parent (Parent (Par))) = N_Subprogram_Body then return True; -- References to Ghost entities may be relocated in internally -- generated bodies. elsif Nkind (Par) = N_Subprogram_Body and then not Comes_From_Source (Par) then Subp_Id := Corresponding_Spec (Par); -- The original context is an expression function that has -- been split into a spec and a body. The context is OK as -- long as the the initial declaration is Ghost. if Present (Subp_Id) then Subp_Decl := Original_Node (Unit_Declaration_Node (Subp_Id)); if Nkind (Subp_Decl) = N_Expression_Function then return Is_Subject_To_Ghost (Subp_Decl); end if; end if; -- Otherwise this is either an internal body or an internal -- completion. Both are OK because the real check was done -- before expansion activities. return True; end if; -- Prevent the search from going too far if Is_Body_Or_Package_Declaration (Par) then return False; end if; Par := Parent (Par); end loop; return False; end Is_Ghost_Declaration; ---------------------------------- -- Is_Ghost_Statement_Or_Pragma -- ---------------------------------- function Is_Ghost_Statement_Or_Pragma (N : Node_Id) return Boolean is function Is_Ghost_Entity_Reference (N : Node_Id) return Boolean; -- Determine whether an arbitrary node denotes a reference to a -- Ghost entity. ------------------------------- -- Is_Ghost_Entity_Reference -- ------------------------------- function Is_Ghost_Entity_Reference (N : Node_Id) return Boolean is Ref : Node_Id; begin -- When the reference extracts a subcomponent, recover the -- related object (SPARK RM 6.9(1)). Ref := N; while Nkind_In (Ref, N_Explicit_Dereference, N_Indexed_Component, N_Selected_Component, N_Slice) loop Ref := Prefix (Ref); end loop; return Is_Entity_Name (Ref) and then Present (Entity (Ref)) and then Is_Ghost_Entity (Entity (Ref)); end Is_Ghost_Entity_Reference; -- Local variables Arg : Node_Id; Stmt : Node_Id; -- Start of processing for Is_Ghost_Statement_Or_Pragma begin if Nkind (N) = N_Pragma then -- A pragma is Ghost when it appears within a Ghost package or -- subprogram. if Ghost_Mode > None then return True; end if; -- A pragma is Ghost when it mentions a Ghost entity Arg := First (Pragma_Argument_Associations (N)); while Present (Arg) loop if Is_Ghost_Entity_Reference (Get_Pragma_Arg (Arg)) then return True; end if; Next (Arg); end loop; end if; Stmt := N; while Present (Stmt) loop if Is_Statement (Stmt) then -- A statement is Ghost when it appears within a Ghost -- package or subprogram. if Ghost_Mode > None then return True; -- An assignment statement or a procedure call is Ghost when -- the name denotes a Ghost entity. elsif Nkind_In (Stmt, N_Assignment_Statement, N_Procedure_Call_Statement) then return Is_Ghost_Entity_Reference (Name (Stmt)); end if; -- Prevent the search from going too far elsif Is_Body_Or_Package_Declaration (Stmt) then return False; end if; Stmt := Parent (Stmt); end loop; return False; end Is_Ghost_Statement_Or_Pragma; -- Start of processing for Is_OK_Ghost_Context begin -- The Ghost entity appears within an assertion expression if In_Assertion_Expr > 0 then return True; -- The Ghost entity is part of a declaration or its completion elsif Is_Ghost_Declaration (Context) then return True; -- The Ghost entity is referenced within a Ghost statement elsif Is_Ghost_Statement_Or_Pragma (Context) then return True; -- Routine Expand_Record_Extension creates a parent subtype without -- inserting it into the tree. There is no good way of recognizing -- this special case as there is no parent. Try to approximate the -- context. elsif No (Parent (Context)) and then Is_Tagged_Type (Ghost_Id) then return True; else return False; end if; end Is_OK_Ghost_Context; ------------------------ -- Check_Ghost_Policy -- ------------------------ procedure Check_Ghost_Policy (Id : Entity_Id; Err_N : Node_Id) is Policy : constant Name_Id := Policy_In_Effect (Name_Ghost); begin -- The Ghost policy in effect a the point of declaration and at the -- point of use must match (SPARK RM 6.9(14)). if Is_Checked_Ghost_Entity (Id) and then Policy = Name_Ignore then Error_Msg_Sloc := Sloc (Err_N); Error_Msg_N ("incompatible ghost policies in effect", Err_N); Error_Msg_NE ("\& declared with ghost policy Check", Err_N, Id); Error_Msg_NE ("\& used # with ghost policy Ignore", Err_N, Id); elsif Is_Ignored_Ghost_Entity (Id) and then Policy = Name_Check then Error_Msg_Sloc := Sloc (Err_N); Error_Msg_N ("incompatible ghost policies in effect", Err_N); Error_Msg_NE ("\& declared with ghost policy Ignore", Err_N, Id); Error_Msg_NE ("\& used # with ghost policy Check", Err_N, Id); end if; end Check_Ghost_Policy; -- Start of processing for Check_Ghost_Context begin -- Once it has been established that the reference to the Ghost entity -- is within a suitable context, ensure that the policy at the point of -- declaration and at the point of use match. if Is_OK_Ghost_Context (Ghost_Ref) then Check_Ghost_Policy (Ghost_Id, Ghost_Ref); -- Otherwise the Ghost entity appears in a non-Ghost context and affects -- its behavior or value. else Error_Msg_N ("ghost entity cannot appear in this context (SPARK RM 6.9(12))", Ghost_Ref); end if; end Check_Ghost_Context; ---------------------------- -- Check_Ghost_Derivation -- ---------------------------- procedure Check_Ghost_Derivation (Typ : Entity_Id) is Parent_Typ : constant Entity_Id := Etype (Typ); Iface : Entity_Id; Iface_Elmt : Elmt_Id; begin -- Allow untagged derivations from predefined types such as Integer as -- those are not Ghost by definition. if Is_Scalar_Type (Typ) and then Parent_Typ = Base_Type (Typ) then null; -- The parent type of a Ghost type extension must be Ghost elsif not Is_Ghost_Entity (Parent_Typ) then Error_Msg_N ("type extension & cannot be ghost", Typ); Error_Msg_NE ("\parent type & is not ghost", Typ, Parent_Typ); return; end if; -- All progenitors (if any) must be Ghost as well if Is_Tagged_Type (Typ) and then Present (Interfaces (Typ)) then Iface_Elmt := First_Elmt (Interfaces (Typ)); while Present (Iface_Elmt) loop Iface := Node (Iface_Elmt); if not Is_Ghost_Entity (Iface) then Error_Msg_N ("type extension & cannot be ghost", Typ); Error_Msg_NE ("\interface type & is not ghost", Typ, Iface); return; end if; Next_Elmt (Iface_Elmt); end loop; end if; end Check_Ghost_Derivation; -------------------------------- -- Implements_Ghost_Interface -- -------------------------------- function Implements_Ghost_Interface (Typ : Entity_Id) return Boolean is Iface_Elmt : Elmt_Id; begin -- Traverse the list of interfaces looking for a Ghost interface if Is_Tagged_Type (Typ) and then Present (Interfaces (Typ)) then Iface_Elmt := First_Elmt (Interfaces (Typ)); while Present (Iface_Elmt) loop if Is_Ghost_Entity (Node (Iface_Elmt)) then return True; end if; Next_Elmt (Iface_Elmt); end loop; end if; return False; end Implements_Ghost_Interface; ---------------- -- Initialize -- ---------------- procedure Initialize is begin Ignored_Ghost_Units.Init; end Initialize; --------------------- -- Is_Ghost_Entity -- --------------------- function Is_Ghost_Entity (Id : Entity_Id) return Boolean is begin return Is_Checked_Ghost_Entity (Id) or else Is_Ignored_Ghost_Entity (Id); end Is_Ghost_Entity; ------------------------- -- Is_Subject_To_Ghost -- ------------------------- function Is_Subject_To_Ghost (N : Node_Id) return Boolean is function Enables_Ghostness (Arg : Node_Id) return Boolean; -- Determine whether aspect or pragma argument Arg enables "ghostness" ----------------------- -- Enables_Ghostness -- ----------------------- function Enables_Ghostness (Arg : Node_Id) return Boolean is Expr : Node_Id; begin Expr := Arg; if Nkind (Expr) = N_Pragma_Argument_Association then Expr := Get_Pragma_Arg (Expr); end if; -- Determine whether the expression of the aspect is static and -- denotes True. if Present (Expr) then Preanalyze_And_Resolve (Expr); return Is_OK_Static_Expression (Expr) and then Is_True (Expr_Value (Expr)); -- Otherwise Ghost defaults to True else return True; end if; end Enables_Ghostness; -- Local variables Id : constant Entity_Id := Defining_Entity (N); Asp : Node_Id; Decl : Node_Id; Prev_Id : Entity_Id; -- Start of processing for Is_Subject_To_Ghost begin -- The related entity of the declaration has not been analyzed yet, do -- not inspect its attributes. if Ekind (Id) = E_Void then null; elsif Is_Ghost_Entity (Id) then return True; -- The completion of a type or a constant is not fully analyzed when the -- reference to the Ghost entity is resolved. Because the completion is -- not marked as Ghost yet, inspect the partial view. elsif Is_Record_Type (Id) or else Ekind (Id) = E_Constant or else (Nkind (N) = N_Object_Declaration and then Constant_Present (N)) then Prev_Id := Incomplete_Or_Partial_View (Id); if Present (Prev_Id) and then Is_Ghost_Entity (Prev_Id) then return True; end if; end if; -- Examine the aspect specifications (if any) looking for aspect Ghost if Permits_Aspect_Specifications (N) then Asp := First (Aspect_Specifications (N)); while Present (Asp) loop if Chars (Identifier (Asp)) = Name_Ghost then return Enables_Ghostness (Expression (Asp)); end if; Next (Asp); end loop; end if; Decl := Empty; -- When the context is a [generic] package declaration, pragma Ghost -- resides in the visible declarations. if Nkind_In (N, N_Generic_Package_Declaration, N_Package_Declaration) then Decl := First (Visible_Declarations (Specification (N))); -- When the context is a package or a subprogram body, pragma Ghost -- resides in the declarative part. elsif Nkind_In (N, N_Package_Body, N_Subprogram_Body) then Decl := First (Declarations (N)); -- Otherwise pragma Ghost appears in the declarations following N elsif Is_List_Member (N) then Decl := Next (N); end if; while Present (Decl) loop if Nkind (Decl) = N_Pragma and then Pragma_Name (Decl) = Name_Ghost then return Enables_Ghostness (First (Pragma_Argument_Associations (Decl))); -- A source construct ends the region where pragma Ghost may appear, -- stop the traversal. elsif Comes_From_Source (Decl) then exit; end if; Next (Decl); end loop; return False; end Is_Subject_To_Ghost; ---------- -- Lock -- ---------- procedure Lock is begin Ignored_Ghost_Units.Locked := True; Ignored_Ghost_Units.Release; end Lock; ---------------------------------- -- Propagate_Ignored_Ghost_Code -- ---------------------------------- procedure Propagate_Ignored_Ghost_Code (N : Node_Id) is Nod : Node_Id; Scop : Entity_Id; 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 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. Add_Ignored_Ghost_Unit (Cunit (Get_Code_Unit (N))); end Propagate_Ignored_Ghost_Code; ------------------------------- -- 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 -- The node is either declared as ignored Ghost or is a byproduct -- of expansion. Destroy it and stop the traversal on this branch. if 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. if Contains_Ignored_Ghost_Code (Id) then return OK; -- Otherwise the construct contains only living code and should -- not be pruned. else return Skip; end if; -- Otherwise keep searching for ignored Ghost nodes else return OK; end if; end Prune_Node; procedure Prune_Nodes is new Traverse_Proc (Prune_Node); -- Start of processing for Prune_Tree begin Prune_Nodes (Root); end Prune_Tree; -- Start of processing for Remove_Ignored_Ghost_Code begin for Index in Ignored_Ghost_Units.First .. Ignored_Ghost_Units.Last loop Prune_Tree (Unit (Ignored_Ghost_Units.Table (Index))); end loop; end Remove_Ignored_Ghost_Code; -------------------- -- Set_Ghost_Mode -- -------------------- procedure Set_Ghost_Mode (N : Node_Id; Prev_Id : Entity_Id := Empty) is procedure Set_Ghost_Mode_From_Entity (Id : Entity_Id); -- Set the value of global variable Ghost_Mode depending on the mode of -- entity Id. procedure Set_Ghost_Mode_From_Policy; -- Set the value of global variable Ghost_Mode depending on the current -- Ghost policy in effect. -------------------------------- -- Set_Ghost_Mode_From_Entity -- -------------------------------- procedure Set_Ghost_Mode_From_Entity (Id : Entity_Id) is begin if Is_Checked_Ghost_Entity (Id) then Ghost_Mode := Check; elsif Is_Ignored_Ghost_Entity (Id) then Ghost_Mode := Ignore; Set_Is_Ignored_Ghost_Node (N); Propagate_Ignored_Ghost_Code (N); end if; end Set_Ghost_Mode_From_Entity; -------------------------------- -- Set_Ghost_Mode_From_Policy -- -------------------------------- procedure Set_Ghost_Mode_From_Policy is Policy : constant Name_Id := Policy_In_Effect (Name_Ghost); begin if Policy = Name_Check then Ghost_Mode := Check; elsif Policy = Name_Ignore then Ghost_Mode := Ignore; Set_Is_Ignored_Ghost_Node (N); Propagate_Ignored_Ghost_Code (N); end if; end Set_Ghost_Mode_From_Policy; -- Local variables Nam : Node_Id; -- Start of processing for Set_Ghost_Mode begin -- The input node denotes one of the many declaration kinds that may be -- subject to pragma Ghost. if Is_Declaration (N) then if Is_Subject_To_Ghost (N) then Set_Ghost_Mode_From_Policy; -- The declaration denotes the completion of a deferred constant, -- pragma Ghost appears on the partial declaration. elsif Nkind (N) = N_Object_Declaration and then Constant_Present (N) and then Present (Prev_Id) then Set_Ghost_Mode_From_Entity (Prev_Id); -- The declaration denotes the full view of a private type, pragma -- Ghost appears on the partial declaration. elsif Nkind (N) = N_Full_Type_Declaration and then Is_Private_Type (Defining_Entity (N)) and then Present (Prev_Id) then Set_Ghost_Mode_From_Entity (Prev_Id); end if; -- The input denotes an assignment or a procedure call. In this case -- the Ghost mode is dictated by the name of the construct. elsif Nkind_In (N, N_Assignment_Statement, N_Procedure_Call_Statement) then -- When the reference extracts a subcomponent, recover the related -- object (SPARK RM 6.9(1)). Nam := Name (N); while Nkind_In (Nam, N_Explicit_Dereference, N_Indexed_Component, N_Selected_Component, N_Slice) loop Nam := Prefix (Nam); end loop; if Is_Entity_Name (Nam) and then Present (Entity (Nam)) then Set_Ghost_Mode_From_Entity (Entity (Nam)); end if; -- The input denotes a package or subprogram body elsif Nkind_In (N, N_Package_Body, N_Subprogram_Body) then if (Present (Prev_Id) and then Is_Ghost_Entity (Prev_Id)) or else Is_Subject_To_Ghost (N) then Set_Ghost_Mode_From_Policy; end if; end if; end Set_Ghost_Mode; ------------------------------- -- Set_Ghost_Mode_For_Freeze -- ------------------------------- procedure Set_Ghost_Mode_For_Freeze (Id : Entity_Id; N : Node_Id) is begin if Is_Checked_Ghost_Entity (Id) then Ghost_Mode := Check; elsif Is_Ignored_Ghost_Entity (Id) then Ghost_Mode := Ignore; Propagate_Ignored_Ghost_Code (N); end if; end Set_Ghost_Mode_For_Freeze; ------------------------- -- Set_Is_Ghost_Entity -- ------------------------- procedure Set_Is_Ghost_Entity (Id : Entity_Id) is Policy : constant Name_Id := Policy_In_Effect (Name_Ghost); begin if Policy = Name_Check then Set_Is_Checked_Ghost_Entity (Id); elsif Policy = Name_Ignore then Set_Is_Ignored_Ghost_Entity (Id); end if; end Set_Is_Ghost_Entity; end Ghost;