Merge from trunk revision 104c05c5284b7822d770ee51a7d91946c7e56d50.

1 files changed, 86 insertions, 22 deletions

diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb
index 866f7f7..42ea0f5 100644
--- a/gcc/ada/ghost.adb
+++ b/gcc/ada/ghost.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2014-2020, Free Software Foundation, Inc.         --
+--          Copyright (C) 2014-2021, 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- --
@@ -24,23 +24,27 @@
 ------------------------------------------------------------------------------
 
 with Alloc;
-with Aspects;  use Aspects;
-with Atree;    use Atree;
-with Einfo;    use Einfo;
-with Elists;   use Elists;
-with Errout;   use Errout;
-with Namet;    use Namet;
-with Nlists;   use Nlists;
-with Nmake;    use Nmake;
-with Sem;      use Sem;
-with Sem_Aux;  use Sem_Aux;
-with Sem_Disp; use Sem_Disp;
-with Sem_Eval; use Sem_Eval;
-with Sem_Prag; use Sem_Prag;
-with Sem_Res;  use Sem_Res;
-with Sem_Util; use Sem_Util;
-with Sinfo;    use Sinfo;
-with Snames;   use Snames;
+with Aspects;        use Aspects;
+with Atree;          use Atree;
+with Einfo;          use Einfo;
+with Einfo.Entities; use Einfo.Entities;
+with Einfo.Utils;    use Einfo.Utils;
+with Elists;         use Elists;
+with Errout;         use Errout;
+with Namet;          use Namet;
+with Nlists;         use Nlists;
+with Nmake;          use Nmake;
+with Sem;            use Sem;
+with Sem_Aux;        use Sem_Aux;
+with Sem_Disp;       use Sem_Disp;
+with Sem_Eval;       use Sem_Eval;
+with Sem_Prag;       use Sem_Prag;
+with Sem_Res;        use Sem_Res;
+with Sem_Util;       use Sem_Util;
+with Sinfo;          use Sinfo;
+with Sinfo.Nodes;    use Sinfo.Nodes;
+with Sinfo.Utils;    use Sinfo.Utils;
+with Snames;         use Snames;
 with Table;
 
 package body Ghost is
@@ -159,6 +163,9 @@ package body Ghost is
       --  Determine whether node Context denotes a Ghost-friendly context where
       --  a Ghost entity can safely reside (SPARK RM 6.9(10)).
 
+      function In_Aspect_Or_Pragma_Predicate (N : Node_Id) return Boolean;
+      --  Return True iff N is enclosed in an aspect or pragma Predicate
+
       -------------------------
       -- Is_OK_Ghost_Context --
       -------------------------
@@ -540,6 +547,40 @@ package body Ghost is
          end if;
       end Check_Ghost_Policy;
 
+      -----------------------------------
+      -- In_Aspect_Or_Pragma_Predicate --
+      -----------------------------------
+
+      function In_Aspect_Or_Pragma_Predicate (N : Node_Id) return Boolean is
+         Par : Node_Id := N;
+      begin
+         while Present (Par) loop
+            if Nkind (Par) = N_Pragma
+              and then Get_Pragma_Id (Par) = Pragma_Predicate
+            then
+               return True;
+
+            elsif Nkind (Par) = N_Aspect_Specification
+              and then Same_Aspect (Get_Aspect_Id (Par), Aspect_Predicate)
+            then
+               return True;
+
+            --  Stop the search when it's clear it cannot be inside an aspect
+            --  or pragma.
+
+            elsif Is_Declaration (Par)
+              or else Is_Statement (Par)
+              or else Is_Body (Par)
+            then
+               return False;
+            end if;
+
+            Par := Parent (Par);
+         end loop;
+
+         return False;
+      end In_Aspect_Or_Pragma_Predicate;
+
    --  Start of processing for Check_Ghost_Context
 
    begin
@@ -555,6 +596,19 @@ package body Ghost is
 
       else
          Error_Msg_N ("ghost entity cannot appear in this context", Ghost_Ref);
+
+         --  When the Ghost entity appears in a pragma Predicate, explain the
+         --  reason for this being illegal, and suggest a fix instead.
+
+         if In_Aspect_Or_Pragma_Predicate (Ghost_Ref) then
+            Error_Msg_N
+              ("\as predicates are checked in membership tests, "
+               & "the type and its predicate must be both ghost",
+               Ghost_Ref);
+            Error_Msg_N
+              ("\either make the type ghost "
+               & "or use a type invariant on a private type", Ghost_Ref);
+         end if;
       end if;
    end Check_Ghost_Context;
 
@@ -1191,11 +1245,21 @@ package body Ghost is
       --  processing them in that mode can lead to spurious errors.
 
       if Expander_Active then
+         --  Cases where full analysis is needed, involving array indexing
+         --  which would otherwise be missing array-bounds checks:
+
          if not Analyzed (Orig_Lhs)
-           and then Nkind (Orig_Lhs) = N_Indexed_Component
-           and then Nkind (Prefix (Orig_Lhs)) = N_Selected_Component
-           and then Nkind (Prefix (Prefix (Orig_Lhs))) =
-           N_Indexed_Component
+           and then
+             ((Nkind (Orig_Lhs) = N_Indexed_Component
+                and then Nkind (Prefix (Orig_Lhs)) = N_Selected_Component
+                and then Nkind (Prefix (Prefix (Orig_Lhs))) =
+                           N_Indexed_Component)
+              or else
+             (Nkind (Orig_Lhs) = N_Selected_Component
+              and then Nkind (Prefix (Orig_Lhs)) = N_Indexed_Component
+              and then Nkind (Prefix (Prefix (Orig_Lhs))) =
+                         N_Selected_Component
+              and then Nkind (Parent (N)) /= N_Loop_Statement))
          then
             Analyze (Orig_Lhs);
          end if;