From 898edf758e03a6cc31219405a667c75b67a726ca Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Fri, 9 Apr 2021 14:53:56 -0400 Subject: [PATCH] [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. --- 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 22ae9c4..a6e4f28 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 be03c97..33cde5a 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 3522753..0995b94 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 907641f..1a39a82 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 5298998..70b93b3 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 2e772ed..85e2abb 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 cd972e1..b81216f 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 d02e587..270242d 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 6a61117..0f3698e 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 723b7a8..1905f23 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 f293684..1d0521c 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 17d27d6..99a545e 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 821c0ab..7339c17 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 f481812..f1a9f84 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 9ccc5c5..893854d 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 76dac2c..d7667f2 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 594e08e..98cbef4 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 d37f295..7b4b288 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 a52b58a..b303229 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 ea0a5bb..14351b3 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 be09453..e639fab 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 169825e..8a4a98b 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 f9db669..7f9bb89 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 ab8e528..2023e67 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 519242e..ff4ff84 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)); -- 2.7.4