@@ -241,6 +241,10 @@ package body Aspects is
-- find the declaration node where the aspects reside. This is usually
-- the parent or the parent of the parent.
+ if No (Parent (Owner)) then
+ return Empty;
+ end if;
+
Decl := Parent (Owner);
if not Permits_Aspect_Specifications (Decl) then
Decl := Parent (Decl);
@@ -488,6 +492,7 @@ package body Aspects is
function Permits_Aspect_Specifications (N : Node_Id) return Boolean is
begin
+ pragma Assert (Present (N));
return Has_Aspect_Specifications_Flag (Nkind (N));
end Permits_Aspect_Specifications;
@@ -1232,7 +1232,9 @@ package body Atree is
if Field in Node_Range then
New_N := Union_Id (Copy_Separate_Tree (Node_Id (Field)));
- if Parent (Node_Id (Field)) = Source then
+ if Present (Node_Id (Field))
+ and then Parent (Node_Id (Field)) = Source
+ then
Set_Parent (Node_Id (New_N), New_Id);
end if;
@@ -1801,16 +1803,14 @@ package body Atree is
end if;
end Paren_Count;
- ------------
- -- Parent --
- ------------
-
- function Parent (N : Node_Id) return Node_Id is
+ function Parent (N : Node_Or_Entity_Id) return Node_Or_Entity_Id is
begin
+ pragma Assert (Atree.Present (N));
+
if Is_List_Member (N) then
return Parent (List_Containing (N));
else
- return Node_Id (Link (N));
+ return Node_Or_Entity_Id (Link (N));
end if;
end Parent;
@@ -2126,9 +2126,9 @@ package body Atree is
-- Set_Parent --
----------------
- procedure Set_Parent (N : Node_Id; Val : Node_Id) is
+ procedure Set_Parent (N : Node_Or_Entity_Id; Val : Node_Or_Entity_Id) is
begin
- pragma Assert (not Locked);
+ pragma Assert (Atree.Present (N));
pragma Assert (not In_List (N));
Set_Link (N, Union_Id (Val));
end Set_Parent;
@@ -414,34 +414,34 @@ package Atree is
-- The following functions return the contents of the indicated field of
-- the node referenced by the argument, which is a Node_Id.
- function No (N : Node_Id) return Boolean;
+ function No (N : Node_Id) return Boolean;
pragma Inline (No);
-- Tests given Id for equality with the Empty node. This allows notations
-- like "if No (Variant_Part)" as opposed to "if Variant_Part = Empty".
- function Parent (N : Node_Id) return Node_Id;
+ function Parent (N : Node_Or_Entity_Id) return Node_Or_Entity_Id;
pragma Inline (Parent);
-- Returns the parent of a node if the node is not a list member, or else
-- the parent of the list containing the node if the node is a list member.
- function Paren_Count (N : Node_Id) return Nat;
+ function Paren_Count (N : Node_Id) return Nat;
pragma Inline (Paren_Count);
-- Number of parentheses that surround an expression
- function Present (N : Node_Id) return Boolean;
+ function Present (N : Node_Id) return Boolean;
pragma Inline (Present);
-- Tests given Id for inequality with the Empty node. This allows notations
-- like "if Present (Statement)" as opposed to "if Statement /= Empty".
- procedure Set_Original_Node (N : Node_Id; Val : Node_Id);
+ procedure Set_Original_Node (N : Node_Id; Val : Node_Id);
pragma Inline (Set_Original_Node);
-- Note that this routine is used only in very peculiar cases. In normal
-- cases, the Original_Node link is set by calls to Rewrite.
- procedure Set_Parent (N : Node_Id; Val : Node_Id);
+ procedure Set_Parent (N : Node_Or_Entity_Id; Val : Node_Or_Entity_Id);
pragma Inline (Set_Parent);
- procedure Set_Paren_Count (N : Node_Id; Val : Nat);
+ procedure Set_Paren_Count (N : Node_Id; Val : Nat);
pragma Inline (Set_Paren_Count);
---------------------------
@@ -2713,6 +2713,10 @@ package body Checks is
Subp_Spec := Parent (Subp);
+ if No (Subp_Spec) then
+ return;
+ end if;
+
if Nkind (Subp_Spec) = N_Defining_Program_Unit_Name then
Subp_Spec := Parent (Subp_Spec);
end if;
@@ -5088,9 +5088,9 @@ package Einfo is
-- Applicable attributes by entity kind --
------------------------------------------
- -- In the conversion to variable-sized nodes and entities, which is an
- -- ongoing project, a number of discrepancies were noticed. They are
- -- documented in comments, and marked with "$$$".
+ -- In the conversion to variable-sized nodes and entities, a number of
+ -- discrepancies were noticed. They are documented in comments, and marked
+ -- with "$$$".
-- E_Abstract_State
-- Refinement_Constituents
@@ -1920,7 +1920,7 @@ package body Exp_Aggr is
function Gen_Loop (L, H : Node_Id; Expr : Node_Id) return List_Id is
Is_Iterated_Component : constant Boolean :=
- Nkind (Parent (Expr)) = N_Iterated_Component_Association;
+ Parent_Kind (Expr) = N_Iterated_Component_Association;
L_J : Node_Id;
@@ -2436,7 +2436,7 @@ package body Exp_Aggr is
Expr := Get_Assoc_Expr (Others_Assoc);
Dup_Expr := New_Copy_Tree (Expr);
- Set_Parent (Dup_Expr, Parent (Expr));
+ Copy_Parent (To => Dup_Expr, From => Expr);
Set_Loop_Actions (Others_Assoc, New_List);
Append_List
@@ -3589,7 +3589,9 @@ package body Exp_Ch6 is
Ren_Root := Alias (Ren_Root);
end if;
- if Present (Original_Node (Parent (Parent (Ren_Root)))) then
+ if Present (Parent (Ren_Root))
+ and then Present (Original_Node (Parent (Parent (Ren_Root))))
+ then
Ren_Decl := Original_Node (Parent (Parent (Ren_Root)));
if Nkind (Ren_Decl) = N_Subprogram_Renaming_Declaration then
@@ -12277,7 +12277,9 @@ package body Exp_Util is
-- Local variables
- Context : constant Node_Id := Parent (Ref);
+ Context : constant Node_Id :=
+ (if No (Ref) then Empty else Parent (Ref));
+
Loc : constant Source_Ptr := Sloc (Ref);
Ref_Id : Entity_Id;
Result : Traverse_Result;
@@ -13493,7 +13495,7 @@ package body Exp_Util is
-- modification of that variable within the loop may incorrectly
-- affect the execution of the loop.
- elsif Nkind (Parent (Parent (N))) = N_Loop_Parameter_Specification
+ elsif Parent_Kind (Parent (N)) = N_Loop_Parameter_Specification
and then Within_In_Parameter (Prefix (N))
and then Variable_Ref
then
@@ -2329,6 +2329,7 @@ package body Gen_IL.Gen is
Put (B, "with Nlists; use Nlists;" & LF);
Put (B, "pragma Warnings (Off);" & LF);
Put (B, "with Einfo.Utils; use Einfo.Utils;" & LF);
+ Put (B, "with Sinfo.Utils; use Sinfo.Utils;" & LF);
Put (B, "pragma Warnings (On);" & LF);
Put (B, LF & "package body Sinfo.Nodes is" & LF & LF);
@@ -187,6 +187,10 @@ package body SPARK_Specific is
| Generic_Subprogram_Kind
| Subprogram_Kind
then
+ if No (Unit_Declaration_Node (N)) then
+ return Empty;
+ end if;
+
Context := Parent (Unit_Declaration_Node (N));
-- If this was a library-level subprogram then replace Context with
@@ -76,7 +76,7 @@ package body Ada.Strings.Wide_Unbounded is
Reference (Empty_Shared_Wide_String'Access);
DR := Empty_Shared_Wide_String'Access;
- -- Left string is empty, return Rigth string
+ -- Left string is empty, return Right string
elsif LR.Last = 0 then
Reference (RR);
@@ -76,7 +76,7 @@ package body Ada.Strings.Wide_Wide_Unbounded is
Reference (Empty_Shared_Wide_Wide_String'Access);
DR := Empty_Shared_Wide_Wide_String'Access;
- -- Left string is empty, return Rigth string
+ -- Left string is empty, return Right string
elsif LR.Last = 0 then
Reference (RR);
@@ -27,11 +27,11 @@
-- file must be properly reflected in the corresponding C header a-nlists.h
with Alloc;
-with Atree; use Atree;
-with Debug; use Debug;
-with Output; use Output;
-with Sinfo; use Sinfo;
-with Sinfo.Nodes; use Sinfo.Nodes;
+with Atree; use Atree;
+with Debug; use Debug;
+with Output; use Output;
+with Sinfo; use Sinfo;
+with Sinfo.Nodes; use Sinfo.Nodes;
with Table;
package body Nlists is
@@ -1015,6 +1015,7 @@ package body Nlists is
function Parent (List : List_Id) return Node_Or_Entity_Id is
begin
+ pragma Assert (Present (List));
pragma Assert (List <= Lists.Last);
return Lists.Table (List).Parent;
end Parent;
@@ -716,9 +716,9 @@ private
File_Names : File_Name_Array_Ptr :=
new File_Name_Array (1 .. Int (Argument_Count) + 2);
-- As arguments are scanned, file names are stored in this array. The
- -- strings do not have terminating NUL files. The array is extensible,
- -- because when using project files, there may be more files than
- -- arguments on the command line.
+ -- strings do not have terminating NULs. The array is extensible, because
+ -- when using project files, there may be more files than arguments on the
+ -- command line.
type File_Index_Array is array (Int range <>) of Int;
type File_Index_Array_Ptr is access File_Index_Array;
@@ -11258,7 +11258,8 @@ package body Sem_Ch12 is
A_Gen_Obj : constant Entity_Id :=
Defining_Identifier (Analyzed_Formal);
Acc_Def : Node_Id := Empty;
- Act_Assoc : constant Node_Id := Parent (Actual);
+ Act_Assoc : constant Node_Id :=
+ (if No (Actual) then Empty else Parent (Actual));
Actual_Decl : Node_Id := Empty;
Decl_Node : Node_Id;
Def : Node_Id;
@@ -11289,7 +11290,7 @@ package body Sem_Ch12 is
Error_Msg_N ("duplicate instantiation of generic parameter", Actual);
end if;
- Set_Parent (List, Parent (Actual));
+ Set_Parent (List, Act_Assoc);
-- OUT present
@@ -11654,7 +11655,9 @@ package body Sem_Ch12 is
end if;
end if;
- if Nkind (Actual) in N_Has_Entity then
+ if Nkind (Actual) in N_Has_Entity
+ and then Present (Entity (Actual))
+ then
Actual_Decl := Parent (Entity (Actual));
end if;
@@ -16339,7 +16342,7 @@ package body Sem_Ch12 is
-- global in the current generic it must be preserved for its
-- instantiation.
- if Nkind (Parent (Typ)) = N_Subtype_Declaration
+ if Parent_Kind (Typ) = N_Subtype_Declaration
and then Present (Generic_Parent_Type (Parent (Typ)))
then
Typ := Base_Type (Typ);
@@ -10652,7 +10652,7 @@ package body Sem_Ch13 is
-- in particular, it has no type.
Err : Boolean;
- -- Set False if error
+ -- Set True if error
-- On entry to this procedure, Entity (Ident) contains a copy of the
-- original expression from the aspect, saved for this purpose, and
@@ -10786,7 +10786,9 @@ package body Sem_Ch13 is
-- Indicate that the expression comes from an aspect specification,
-- which is used in subsequent analysis even if expansion is off.
- Set_Parent (End_Decl_Expr, ASN);
+ if Present (End_Decl_Expr) then
+ Set_Parent (End_Decl_Expr, ASN);
+ end if;
-- In a generic context the original aspect expressions have not
-- been preanalyzed, so do it now. There are no conformance checks
@@ -6189,7 +6189,7 @@ package body Sem_Ch3 is
-- the master_id associated with an anonymous access to task type
-- component (see Expand_N_Full_Type_Declaration.Build_Master)
- Set_Parent (Element_Type, Parent (T));
+ Copy_Parent (To => Element_Type, From => T);
-- Ada 2005 (AI-230): In case of components that are anonymous access
-- types the level of accessibility depends on the enclosing type
@@ -10361,7 +10361,7 @@ package body Sem_Ch3 is
if Discrim_Present then
null;
- elsif Nkind (Parent (Parent (Def))) = N_Component_Declaration
+ elsif Parent_Kind (Parent (Def)) = N_Component_Declaration
and then Has_Per_Object_Constraint
(Defining_Identifier (Parent (Parent (Def))))
then
@@ -22391,10 +22391,10 @@ package body Sem_Ch3 is
Final_Storage_Only := not Is_Controlled (T);
- -- Ada 2005: Check whether an explicit Limited is present in a derived
+ -- Ada 2005: Check whether an explicit "limited" is present in a derived
-- type declaration.
- if Nkind (Parent (Def)) = N_Derived_Type_Definition
+ if Parent_Kind (Def) = N_Derived_Type_Definition
and then Limited_Present (Parent (Def))
then
Set_Is_Limited_Record (T);
@@ -11709,7 +11709,7 @@ package body Sem_Ch6 is
if Inside_Freezing_Actions = 0
and then Is_Package_Or_Generic_Package (Current_Scope)
and then In_Private_Part (Current_Scope)
- and then Nkind (Parent (E)) = N_Private_Extension_Declaration
+ and then Parent_Kind (E) = N_Private_Extension_Declaration
and then Nkind (Parent (S)) = N_Full_Type_Declaration
and then Full_View (Defining_Identifier (Parent (E)))
= Defining_Identifier (Parent (S))
@@ -3765,16 +3765,20 @@ package body Sem_Dim is
---------------
function System_Of (E : Entity_Id) return System_Type is
- Type_Decl : constant Node_Id := Parent (E);
-
begin
- -- Look for Type_Decl in System_Table
+ if Present (E) then
+ declare
+ Type_Decl : constant Node_Id := Parent (E);
+ begin
+ -- Look for Type_Decl in System_Table
- for Dim_Sys in 1 .. System_Table.Last loop
- if Type_Decl = System_Table.Table (Dim_Sys).Type_Decl then
- return System_Table.Table (Dim_Sys);
- end if;
- end loop;
+ for Dim_Sys in 1 .. System_Table.Last loop
+ if Type_Decl = System_Table.Table (Dim_Sys).Type_Decl then
+ return System_Table.Table (Dim_Sys);
+ end if;
+ end loop;
+ end;
+ end if;
return Null_System;
end System_Of;
@@ -9257,7 +9257,9 @@ package body Sem_Prag is
-- just the same scope). If the pragma comes from an aspect
-- specification we know that it is part of the declaration.
- elsif Parent (Unit_Declaration_Node (Def_Id)) /= Parent (N)
+ elsif (No (Unit_Declaration_Node (Def_Id))
+ or else Parent (Unit_Declaration_Node (Def_Id)) /=
+ Parent (N))
and then Nkind (Parent (N)) /= N_Compilation_Unit_Aux
and then not From_Aspect_Specification (N)
then
@@ -9848,7 +9850,7 @@ package body Sem_Prag is
-- inlineable either.
elsif Is_Generic_Instance (Subp)
- or else Nkind (Parent (Parent (Subp))) = N_Subprogram_Declaration
+ or else Parent_Kind (Parent (Subp)) = N_Subprogram_Declaration
then
null;
@@ -9894,7 +9896,11 @@ package body Sem_Prag is
if In_Same_Source_Unit (Subp, Inner_Subp) then
Set_Inline_Flags (Inner_Subp);
- Decl := Parent (Parent (Inner_Subp));
+ if Present (Parent (Inner_Subp)) then
+ Decl := Parent (Parent (Inner_Subp));
+ else
+ Decl := Empty;
+ end if;
if Nkind (Decl) = N_Subprogram_Declaration
and then Present (Corresponding_Body (Decl))
@@ -30892,7 +30898,7 @@ package body Sem_Prag is
-- Follow subprogram renaming chain
if Is_Subprogram (Def_Id)
- and then Nkind (Parent (Declaration_Node (Def_Id))) =
+ and then Parent_Kind (Declaration_Node (Def_Id)) =
N_Subprogram_Renaming_Declaration
and then Present (Alias (Def_Id))
then
@@ -9162,8 +9162,9 @@ package body Sem_Res is
return;
end if;
- if Nkind (Parent (N)) = N_Indexed_Component
- or else Nkind (Parent (Parent (N))) = N_Indexed_Component
+ if Present (Parent (N))
+ and then (Nkind (Parent (N)) = N_Indexed_Component
+ or else Nkind (Parent (Parent (N))) = N_Indexed_Component)
then
Result_Type := Base_Type (Typ);
end if;
@@ -2027,7 +2027,7 @@ package body Sem_Util is
-- the original constraint from its component declaration.
Sel := Entity (Selector_Name (N));
- if Nkind (Parent (Sel)) /= N_Component_Declaration then
+ if Parent_Kind (Sel) /= N_Component_Declaration then
return Empty;
end if;
end if;
@@ -6366,8 +6366,8 @@ package body Sem_Util is
Is_Type_In_Pkg :=
Is_Package_Or_Generic_Package (B_Scope)
and then
- Nkind (Parent (Declaration_Node (First_Subtype (T)))) /=
- N_Package_Body;
+ Parent_Kind (Declaration_Node (First_Subtype (T))) /=
+ N_Package_Body;
while Present (Id) loop
@@ -6385,8 +6385,8 @@ package body Sem_Util is
and then (Is_Type_In_Pkg
or else Is_Derived_Type (B_Type)
or else Is_Primitive (Id))
- and then Nkind (Parent (Parent (Id)))
- not in N_Formal_Subprogram_Declaration
+ and then Parent_Kind (Parent (Id))
+ not in N_Formal_Subprogram_Declaration
then
Is_Prim := False;
@@ -20042,7 +20042,8 @@ package body Sem_Util is
function Is_Renamed_Entry (Proc_Nam : Entity_Id) return Boolean is
Orig_Node : Node_Id := Empty;
- Subp_Decl : Node_Id := Parent (Parent (Proc_Nam));
+ Subp_Decl : Node_Id :=
+ (if No (Parent (Proc_Nam)) then Empty else Parent (Parent (Proc_Nam)));
function Is_Entry (Nam : Node_Id) return Boolean;
-- Determine whether Nam is an entry. Traverse selectors if there are
@@ -27072,7 +27073,7 @@ package body Sem_Util is
-- or an exception handler). We skip this if Cond is True, since the
-- capturing of values from conditional tests handles this ok.
- if Cond then
+ if Cond or else No (N) then
return True;
end if;
@@ -137,6 +137,29 @@ package body Sinfo.Utils is
Write_Eol;
end Node_Debug_Output;
+ -------------------------------
+ -- Parent-related operations --
+ -------------------------------
+
+ procedure Copy_Parent (To, From : Node_Or_Entity_Id) is
+ begin
+ if Atree.Present (To) and Atree.Present (From) then
+ Atree.Set_Parent (To, Atree.Parent (From));
+ else
+ pragma Assert
+ (if Atree.Present (To) then Atree.No (Atree.Parent (To)));
+ end if;
+ end Copy_Parent;
+
+ function Parent_Kind (N : Node_Id) return Node_Kind is
+ begin
+ if Atree.No (N) then
+ return N_Empty;
+ else
+ return Nkind (Atree.Parent (N));
+ end if;
+ end Parent_Kind;
+
-------------------------
-- Iterator Procedures --
-------------------------
@@ -27,6 +27,18 @@ with Sinfo.Nodes; use Sinfo.Nodes;
package Sinfo.Utils is
+ -------------------------------
+ -- Parent-related operations --
+ -------------------------------
+
+ procedure Copy_Parent (To, From : Node_Or_Entity_Id);
+ -- Does Set_Parent (To, Parent (From)), except that if To or From are
+ -- empty, does nothing. If From is empty but To is not, then Parent (To)
+ -- should already be Empty.
+
+ function Parent_Kind (N : Node_Id) return Node_Kind;
+ -- Same as Nkind (Parent (N)), except if N is Empty, return N_Empty
+
-------------------------
-- Iterator Procedures --
-------------------------
@@ -412,7 +412,7 @@ package body Treepr is
return Nlists.Parent (List_Id (N));
when Node_Range =>
- return Atree.Parent (Node_Or_Entity_Id (N));
+ return Parent (Node_Or_Entity_Id (N));
when others =>
Write_Int (Int (N));