public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-1882] [Ada] tech debt: Parent (Empty) is not allowed
@ 2021-06-29 14:25 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-06-29 14:25 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:898edf758e03a6cc31219405a667c75b67a726ca
commit r12-1882-g898edf758e03a6cc31219405a667c75b67a726ca
Author: Bob Duff <duff@adacore.com>
Date: Fri Apr 9 14:53:56 2021 -0400
[Ada] tech debt: Parent (Empty) is not allowed
gcc/ada/
* atree.adb, atree.ads (Parent, Set_Parent): Assert node is
Present.
(Copy_Parent, Parent_Kind): New helper routines.
* gen_il-gen.adb: Add with clause.
* nlists.adb (Parent): Assert Parent of list is Present.
* aspects.adb, checks.adb, exp_aggr.adb, exp_ch6.adb,
exp_util.adb, lib-xref-spark_specific.adb, osint.ads,
sem_ch12.adb, sem_ch13.adb, sem_ch3.adb, sem_ch6.adb,
sem_dim.adb, sem_prag.adb, sem_res.adb, sem_util.adb,
treepr.adb: Do not call Parent and Set_Parent on the Empty node.
* libgnat/a-stwiun__shared.adb, libgnat/a-stzunb__shared.adb:
Minor: Fix typos in comments.
* einfo.ads: Minor comment update.
* sinfo-utils.ads, sinfo-utils.adb (Parent_Kind, Copy_Parent):
New functions.
Diff:
---
gcc/ada/aspects.adb | 5 +++++
gcc/ada/atree.adb | 18 +++++++++---------
gcc/ada/atree.ads | 14 +++++++-------
gcc/ada/checks.adb | 4 ++++
gcc/ada/einfo.ads | 6 +++---
gcc/ada/exp_aggr.adb | 4 ++--
gcc/ada/exp_ch6.adb | 4 +++-
gcc/ada/exp_util.adb | 6 ++++--
gcc/ada/gen_il-gen.adb | 1 +
gcc/ada/lib-xref-spark_specific.adb | 4 ++++
gcc/ada/libgnat/a-stwiun__shared.adb | 2 +-
gcc/ada/libgnat/a-stzunb__shared.adb | 2 +-
gcc/ada/nlists.adb | 11 ++++++-----
gcc/ada/osint.ads | 6 +++---
gcc/ada/sem_ch12.adb | 11 +++++++----
gcc/ada/sem_ch13.adb | 6 ++++--
gcc/ada/sem_ch3.adb | 8 ++++----
gcc/ada/sem_ch6.adb | 2 +-
gcc/ada/sem_dim.adb | 20 ++++++++++++--------
gcc/ada/sem_prag.adb | 14 ++++++++++----
gcc/ada/sem_res.adb | 5 +++--
gcc/ada/sem_util.adb | 15 ++++++++-------
gcc/ada/sinfo-utils.adb | 23 +++++++++++++++++++++++
gcc/ada/sinfo-utils.ads | 12 ++++++++++++
gcc/ada/treepr.adb | 2 +-
25 files changed, 138 insertions(+), 67 deletions(-)
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index 22ae9c4d217..a6e4f28f2cb 100644
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -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;
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index be03c97a65a..33cde5ad0b3 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -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;
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index 352275315a5..0995b945aaf 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -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);
---------------------------
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 907641fca17..1a39a821f39 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -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;
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 5298998eba5..70b93b32495 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -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
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 2e772ed799a..85e2abb0732 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -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
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index cd972e1a9c2..b81216fb0c7 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -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
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index d02e587d853..270242d8ff9 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -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
diff --git a/gcc/ada/gen_il-gen.adb b/gcc/ada/gen_il-gen.adb
index 6a61117a831..0f3698ea33b 100644
--- a/gcc/ada/gen_il-gen.adb
+++ b/gcc/ada/gen_il-gen.adb
@@ -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);
diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb
index 723b7a8af9d..1905f23a325 100644
--- a/gcc/ada/lib-xref-spark_specific.adb
+++ b/gcc/ada/lib-xref-spark_specific.adb
@@ -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
diff --git a/gcc/ada/libgnat/a-stwiun__shared.adb b/gcc/ada/libgnat/a-stwiun__shared.adb
index f2936840868..1d0521cb6f6 100644
--- a/gcc/ada/libgnat/a-stwiun__shared.adb
+++ b/gcc/ada/libgnat/a-stwiun__shared.adb
@@ -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);
diff --git a/gcc/ada/libgnat/a-stzunb__shared.adb b/gcc/ada/libgnat/a-stzunb__shared.adb
index 17d27d6dc90..99a545e1437 100644
--- a/gcc/ada/libgnat/a-stzunb__shared.adb
+++ b/gcc/ada/libgnat/a-stzunb__shared.adb
@@ -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);
diff --git a/gcc/ada/nlists.adb b/gcc/ada/nlists.adb
index 821c0ab24fd..7339c17fcb1 100644
--- a/gcc/ada/nlists.adb
+++ b/gcc/ada/nlists.adb
@@ -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;
diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads
index f481812bddd..f1a9f848c25 100644
--- a/gcc/ada/osint.ads
+++ b/gcc/ada/osint.ads
@@ -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;
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 9ccc5c5263f..893854ded94 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -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);
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 76dac2c424f..d7667f27026 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -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
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 594e08ef744..98cbef483db 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -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);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d37f295d917..7b4b288e050 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -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))
diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index a52b58a8689..b303229decf 100644
--- a/gcc/ada/sem_dim.adb
+++ b/gcc/ada/sem_dim.adb
@@ -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;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index ea0a5bb5bce..14351b3f3be 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -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
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index be0945325fd..e639fab92e4 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -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;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 169825ec030..8a4a98b5115 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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;
diff --git a/gcc/ada/sinfo-utils.adb b/gcc/ada/sinfo-utils.adb
index f9db66982b0..7f9bb899989 100644
--- a/gcc/ada/sinfo-utils.adb
+++ b/gcc/ada/sinfo-utils.adb
@@ -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 --
-------------------------
diff --git a/gcc/ada/sinfo-utils.ads b/gcc/ada/sinfo-utils.ads
index ab8e52866dc..2023e6726f0 100644
--- a/gcc/ada/sinfo-utils.ads
+++ b/gcc/ada/sinfo-utils.ads
@@ -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 --
-------------------------
diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb
index 519242e1d16..ff4ff846f9f 100644
--- a/gcc/ada/treepr.adb
+++ b/gcc/ada/treepr.adb
@@ -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));
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-06-29 14:25 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-06-29 14:25 [gcc r12-1882] [Ada] tech debt: Parent (Empty) is not allowed Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).