[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 --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index 22ae9c4d21701be07f1a8b6011115a25f378ae83..a6e4f28f2cb93deccde0bab27434b821f872c3fc 100644 (file)
--- 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 be03c97a65afa913199701359ac61540c28cb1fd..33cde5ad0b3abdf7a3b92e5ded5adb1be7a0edde 100644 (file)
--- 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 352275315a5c87c9a716fed4525c007d19a700ba..0995b945aafd48f8d7052dfbf3cb7830f9184b8b 100644 (file)
--- 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 907641fca172908413888136ba6456c3f64d3210..1a39a821f3931bf3a02340f7390a13bc9237d9e6 100644 (file)
--- 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 5298998eba52e329aa1ad9b1bcd5e072a32a99b3..70b93b32495491974fdb8cc5d1590c30ce53d289 100644 (file)
--- 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 2e772ed799ac15314cefc03067a49ba9f290da60..85e2abb07323db6295cbb49f3faf9bf94cf15057 100644 (file)
--- 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 cd972e1a9c2a9a19416be5820bede81482378e1d..b81216fb0c73143eab28a9affe58d5c95713802f 100644 (file)
--- 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 d02e587d853792b1f98950253af88676fa7f9ef2..270242d8ff915cb0452593cf9332da432f31db56 100644 (file)
--- 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 6a61117a8319263f9110e288f34d232fee0595bf..0f3698ea33be38463098eacb887df388562ecc31 100644 (file)
--- 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 723b7a8af9dbf8c0e32eb2a8abd308122e33d3a2..1905f23a325f42bc27885834b1d21299420dc590 100644 (file)
--- 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 f2936840868878e873b767844696637913df1931..1d0521cb6f67b9f91a798e94611132b05f3f7987 100644 (file)
--- 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 17d27d6dc90f3f8599e52bf93c9133490027384f..99a545e1437158e67e4ba38fda7983f40717cfdd 100644 (file)
--- 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 821c0ab24fd2616fa40a0abccefcc722be6c6cda..7339c17fcb1be80f90cd5017a746a8e5739de0f4 100644 (file)
--- 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 f481812bddd2b709af4b47671cd3c318e7137127..f1a9f848c2502ac1cebba66e6219bbcd67513049 100644 (file)
--- 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 9ccc5c5263f25e74053592fae75ebb24234cef09..893854ded94262e013c3acf37c50cd1b7e9b55d3 100644 (file)
--- 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 76dac2c424fb9b5fdab0b2343831f4e1dc82d2e2..d7667f2702677a39619aeaa361c36795c8e15472 100644 (file)
--- 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 594e08ef744f1564a0784a653f44802fd69a29d8..98cbef483db13a29d2fa976389599d8c1d0ae553 100644 (file)
--- 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 d37f295d917682fce2115194a285dafcb56b8728..7b4b288e050084b2256a3cd99387c81d427b6ec2 100644 (file)
--- 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 a52b58a8689db8501d1929decb2e33c71eb39ee9..b303229decf838339400f2e714da46ef5f571177 100644 (file)
--- 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 ea0a5bb5bceff0bd061f4b4d3b58a8bb0b9d82ba..14351b3f3be3e9ff8254ea9a7c505405d2f149ab 100644 (file)
--- 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 be0945325fd5c59cb2667835c76c7c83eb7243bd..e639fab92e47f5ccc4adef5ca8540273abc7c09d 100644 (file)
--- 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 169825ec03065cbb768b15e9559c993bfca0876c..8a4a98b51154cf64c6ad138a6748136b978fffdb 100644 (file)
--- 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 f9db66982b08cb856752f5e52b5f0ad0376da8b1..7f9bb899989f0b77f5b442bd4646b54ecc83949a 100644 (file)
--- 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 ab8e52866dc25809a3d2d059801ddd9d520d0d01..2023e6726f0e4d27ff169d5fc49239cd8c33e46a 100644 (file)
--- 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 519242e1d161e07a03c2ecaf77238ab9d228a200..ff4ff846f9f6ce92223c1bb8f2d2f5b217088a4b 100644 (file)
--- 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));