Daily bump.
[gcc.git] / gcc / ada / lib-xref.adb
index d40f0d42fbd29dae992efda83bfcae7d8004d3d9..64b9683a784000e084890fc118aabf41d9d86d23 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2017, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2020, 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- --
@@ -27,6 +27,7 @@ with Atree;    use Atree;
 with Csets;    use Csets;
 with Elists;   use Elists;
 with Errout;   use Errout;
+with Lib.Util; use Lib.Util;
 with Nlists;   use Nlists;
 with Opt;      use Opt;
 with Restrict; use Restrict;
@@ -52,6 +53,14 @@ package body Lib.Xref is
    -- Declarations --
    ------------------
 
+   package Deferred_References is new Table.Table (
+     Table_Component_Type => Deferred_Reference_Entry,
+     Table_Index_Type     => Int,
+     Table_Low_Bound      => 0,
+     Table_Initial        => 512,
+     Table_Increment      => 200,
+     Table_Name           => "Name_Deferred_References");
+
    --  The Xref table is used to record references. The Loc field is set
    --  to No_Location for a definition entry.
 
@@ -198,6 +207,21 @@ package body Lib.Xref is
       end if;
    end Add_Entry;
 
+   ---------------------
+   -- Defer_Reference --
+   ---------------------
+
+   procedure Defer_Reference (Deferred_Reference : Deferred_Reference_Entry) is
+   begin
+      --  If Get_Ignore_Errors, then we are in Preanalyze_Without_Errors, and
+      --  we should not record cross references, because that will cause
+      --  duplicates when we call Analyze.
+
+      if not Get_Ignore_Errors then
+         Deferred_References.Append (Deferred_Reference);
+      end if;
+   end Defer_Reference;
+
    -----------
    -- Equal --
    -----------
@@ -415,6 +439,7 @@ package body Lib.Xref is
       function Get_Through_Renamings (E : Entity_Id) return Entity_Id is
       begin
          case Ekind (E) is
+
             --  For subprograms we just need to check once if they are have a
             --  Renamed_Entity, because Renamed_Entity is set transitively.
 
@@ -443,6 +468,7 @@ package body Lib.Xref is
 
                      declare
                         Renamed : constant Entity_Id := Renamed_Object (Obj);
+
                      begin
                         if Present (Renamed) then
                            Obj := Get_Enclosing_Object (Renamed);
@@ -450,6 +476,7 @@ package body Lib.Xref is
                            --  The renamed expression denotes a non-object,
                            --  e.g. function call, slicing of a function call,
                            --  pointer dereference, etc.
+
                            if No (Obj) then
                               return Empty;
                            end if;
@@ -565,10 +592,9 @@ package body Lib.Xref is
                P := Parent (P);
 
                if Nkind (P) = N_Pragma then
-                  if Nam_In (Pragma_Name_Unmapped (P),
-                             Name_Warnings,
-                             Name_Unmodified,
-                             Name_Unreferenced)
+                  if Pragma_Name_Unmapped (P) in Name_Warnings
+                                               | Name_Unmodified
+                                               | Name_Unreferenced
                   then
                      return False;
                   end if;
@@ -592,7 +618,20 @@ package body Lib.Xref is
    --  Start of processing for Generate_Reference
 
    begin
-      pragma Assert (Nkind (E) in N_Entity);
+      --  If Get_Ignore_Errors, then we are in Preanalyze_Without_Errors, and
+      --  we should not record cross references, because that will cause
+      --  duplicates when we call Analyze.
+
+      if Get_Ignore_Errors then
+         return;
+      end if;
+
+      --  May happen in case of severe errors
+
+      if Nkind (E) not in N_Entity then
+         return;
+      end if;
+
       Find_Actual (N, Formal, Call);
 
       if Present (Formal) then
@@ -662,7 +701,7 @@ package body Lib.Xref is
 
       --  Do not generate references if we are within a postcondition sub-
       --  program, because the reference does not comes from source, and the
-      --  pre-analysis of the aspect has already created an entry for the ALI
+      --  preanalysis of the aspect has already created an entry for the ALI
       --  file at the proper source location.
 
       if Chars (Current_Scope) = Name_uPostconditions then
@@ -907,7 +946,7 @@ package body Lib.Xref is
             --  since the attribute acts as an anonymous alias of the function
             --  result and not as a real reference to the function.
 
-            elsif Ekind_In (E, E_Function, E_Generic_Function)
+            elsif Ekind (E) in E_Function | E_Generic_Function
               and then Is_Entity_Name (N)
               and then Is_Attribute_Result (Parent (N))
             then
@@ -1002,18 +1041,18 @@ package body Lib.Xref is
 
         and then Typ /= ' '
       then
-         if Nkind_In (N, N_Identifier,
-                         N_Defining_Identifier,
-                         N_Defining_Operator_Symbol,
-                         N_Operator_Symbol,
-                         N_Defining_Character_Literal)
-           or else Nkind (N) in N_Op
+         if Nkind (N) in N_Identifier
+                       | N_Defining_Identifier
+                       | N_Defining_Operator_Symbol
+                       | N_Operator_Symbol
+                       | N_Defining_Character_Literal
+                       | N_Op
            or else (Nkind (N) = N_Character_Literal
                      and then Sloc (Entity (N)) /= Standard_Location)
          then
             Nod := N;
 
-         elsif Nkind_In (N, N_Expanded_Name, N_Selected_Component) then
+         elsif Nkind (N) in N_Expanded_Name | N_Selected_Component then
             Nod := Selector_Name (N);
 
          else
@@ -1030,7 +1069,7 @@ package body Lib.Xref is
          --  parameters may end up being marked as not coming from source
          --  although they are. Take these into account specially.
 
-         elsif GNATprove_Mode and then Ekind (E) in Formal_Kind then
+         elsif GNATprove_Mode and then Is_Formal (E) then
             Ent := E;
 
          --  Entity does not come from source, but is a derived subprogram and
@@ -1076,7 +1115,7 @@ package body Lib.Xref is
          --  original discriminant, which gets the reference.
 
          elsif Ekind (E) = E_In_Parameter
-           and then  Present (Discriminal_Link (E))
+           and then Present (Discriminal_Link (E))
          then
             Ent := Discriminal_Link (E);
             Set_Referenced (Ent);
@@ -1123,6 +1162,21 @@ package body Lib.Xref is
          --  Comment needed here for special SPARK code ???
 
          if GNATprove_Mode then
+
+            --  Ignore references to an entity which is a Part_Of single
+            --  concurrent object. Ideally we would prefer to add it as a
+            --  reference to the corresponding concurrent type, but it is quite
+            --  difficult (as such references are not currently added even for)
+            --  reads/writes of private protected components) and not worth the
+            --  effort.
+
+            if Ekind (Ent) in E_Abstract_State | E_Constant | E_Variable
+              and then Present (Encapsulating_State (Ent))
+              and then Is_Single_Concurrent_Object (Encapsulating_State (Ent))
+            then
+               return;
+            end if;
+
             Ref := Sloc (Nod);
             Def := Sloc (Ent);
 
@@ -1633,7 +1687,7 @@ package body Lib.Xref is
       begin
          --  Generate language name from convention
 
-         if Conv  = Convention_C then
+         if Conv = Convention_C or else Conv in Convention_C_Variadic then
             Language_Name := Name_C;
 
          elsif Conv = Convention_CPP then
@@ -2295,15 +2349,15 @@ package body Lib.Xref is
                   --  Special handling for access parameters and objects and
                   --  components of an anonymous access type.
 
-                  if Ekind_In (Etype (XE.Key.Ent),
-                               E_Anonymous_Access_Type,
-                               E_Anonymous_Access_Subprogram_Type,
-                               E_Anonymous_Access_Protected_Subprogram_Type)
+                  if Ekind (Etype (XE.Key.Ent)) in
+                               E_Anonymous_Access_Type
+                             | E_Anonymous_Access_Subprogram_Type
+                             | E_Anonymous_Access_Protected_Subprogram_Type
                   then
                      if Is_Formal (XE.Key.Ent)
                        or else
-                         Ekind_In
-                           (XE.Key.Ent, E_Variable, E_Constant, E_Component)
+                         Ekind (XE.Key.Ent) in
+                           E_Variable | E_Constant | E_Component
                      then
                         Ctyp := 'p';
                      end if;
@@ -2699,7 +2753,7 @@ package body Lib.Xref is
                   if XE.Key.Loc /= No_Location
                     and then
                       (XE.Key.Loc /= Crloc
-                        or else (Prevt = 'm' and then  XE.Key.Typ = 'r'))
+                        or else (Prevt = 'm' and then XE.Key.Typ = 'r'))
                   then
                      Crloc := XE.Key.Loc;
                      Prevt := XE.Key.Typ;