[Ada] Crash on ignored Ghost assignment

This patch modifies the way analysis determine whether an assignment is
an ignored Ghost assignment. This is now achieved by preanalyzing a copy
of the left hand side in order to account for potential code generated
by the left hand side itself.

No small reproducer possible.

2018-11-14  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* ghost.adb (Ghost_Entity): New routine.
	(Mark_And_Set_Ghost_Assignment): Reimplemented.
	* sem_ch5.adb (Analyze_Assignment): Assess whether the target of
	the assignment is an ignored Ghost entity before analyzing the
	left hand side.
	* sem_ch8.adb (Find_Direct_Name): Update the subprogram
	signature. Do not generate markers and references when they are
	not desired.
	(Nvis_Messages): Do not execute when errors are not desired.
	(Undefined): Do not emit errors when they are not desired.
	* sem_ch8.ads (Find_Direct_Name): Update the subprogram
	signature and comment on usage.
	* sem_util.adb (Ultimate_Prefix): New routine.
	* sem_util.ads (Ultimate_Prefix): New routine.

From-SVN: r266120

gcc/ada/ChangeLog

+2018-11-14  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* ghost.adb (Ghost_Entity): New routine.
+	(Mark_And_Set_Ghost_Assignment): Reimplemented.
+	* sem_ch5.adb (Analyze_Assignment): Assess whether the target of
+	the assignment is an ignored Ghost entity before analyzing the
+	left hand side.
+	* sem_ch8.adb (Find_Direct_Name): Update the subprogram
+	signature. Do not generate markers and references when they are
+	not desired.
+	(Nvis_Messages): Do not execute when errors are not desired.
+	(Undefined): Do not emit errors when they are not desired.
+	* sem_ch8.ads (Find_Direct_Name): Update the subprogram
+	signature and comment on usage.
+	* sem_util.adb (Ultimate_Prefix): New routine.
+	* sem_util.ads (Ultimate_Prefix): New routine.
+
 2018-11-14  Justin Squirek  <squirek@adacore.com>
 
 	* sem_ch7.adb (Uninstall_Declarations): Add conditional to avoid

gcc/ada/ghost.adb

@@ -34,6 +34,7 @@ with Nlists;   use Nlists;
 with Nmake;    use Nmake;
 with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
+with Sem_Ch8;  use Sem_Ch8;
 with Sem_Disp; use Sem_Disp;
 with Sem_Eval; use Sem_Eval;
 with Sem_Prag; use Sem_Prag;
@@ -64,9 +65,10 @@ package body Ghost is
    -- Local subprograms --
    -----------------------
 
-   function Ghost_Entity (N : Node_Id) return Entity_Id;
-   --  Find the entity of a reference to a Ghost entity. Return Empty if there
-   --  is no such entity.
+   function Ghost_Entity (Ref : Node_Id) return Entity_Id;
+   pragma Inline (Ghost_Entity);
+   --  Obtain the entity of a Ghost entity from reference Ref. Return Empty if
+   --  no such entity exists.
 
    procedure Install_Ghost_Mode (Mode : Ghost_Mode_Type);
    pragma Inline (Install_Ghost_Mode);
@@ -829,24 +831,18 @@ package body Ghost is
    -- Ghost_Entity --
    ------------------
 
-   function Ghost_Entity (N : Node_Id) return Entity_Id is
-      Ref : Node_Id;
+   function Ghost_Entity (Ref : Node_Id) return Entity_Id is
+      Obj_Ref : constant Node_Id := Ultimate_Prefix (Ref);
 
    begin
-      --  When the reference denotes a subcomponent, recover the related
+      --  When the reference denotes a subcomponent, recover the related whole
       --  object (SPARK RM 6.9(1)).
 
-      Ref := N;
-      while Nkind_In (Ref, N_Explicit_Dereference,
-                           N_Indexed_Component,
-                           N_Selected_Component,
-                           N_Slice)
-      loop
-         Ref := Prefix (Ref);
-      end loop;
+      if Is_Entity_Name (Obj_Ref) then
+         return Entity (Obj_Ref);
+
+      --  Otherwise the reference cannot possibly denote a Ghost entity
 
-      if Is_Entity_Name (Ref) then
-         return Entity (Ref);
       else
          return Empty;
       end if;
@@ -1181,13 +1177,50 @@ package body Ghost is
    -----------------------------------
 
    procedure Mark_And_Set_Ghost_Assignment (N : Node_Id) is
-      Id : Entity_Id;
+      Orig_Lhs : constant Node_Id := Name (N);
+      Orig_Ref : constant Node_Id := Ultimate_Prefix (Orig_Lhs);
+
+      Id  : Entity_Id;
+      Ref : Node_Id;
 
    begin
+      --  A reference to a whole Ghost object (SPARK RM 6.9(1)) appears as an
+      --  identifier. If the reference has not been analyzed yet, preanalyze a
+      --  copy of the reference to discover the nature of its entity.
+
+      if Nkind (Orig_Ref) = N_Identifier and then not Analyzed (Orig_Ref) then
+         Ref := New_Copy_Tree (Orig_Ref);
+
+         --  Alter the assignment statement by setting its left-hand side to
+         --  the copy.
+
+         Set_Name   (N, Ref);
+         Set_Parent (Ref, N);
+
+         --  Preanalysis is carried out by looking for a Ghost entity while
+         --  suppressing all possible side effects.
+
+         Find_Direct_Name
+           (N            => Ref,
+            Errors_OK    => False,
+            Marker_OK    => False,
+            Reference_OK => False);
+
+         --  Restore the original state of the assignment statement
+
+         Set_Name (N, Orig_Lhs);
+
+      --  A potential reference to a Ghost entity is already properly resolved
+      --  when the left-hand side is analyzed.
+
+      else
+         Ref := Orig_Ref;
+      end if;
+
       --  An assignment statement becomes Ghost when its target denotes a Ghost
       --  object. Install the Ghost mode of the target.
 
-      Id := Ghost_Entity (Name (N));
+      Id := Ghost_Entity (Ref);
 
       if Present (Id) then
          if Is_Checked_Ghost_Entity (Id) then

gcc/ada/sem_ch5.adb

@@ -452,16 +452,16 @@ package body Sem_Ch5 is
 
       --  Local variables
 
+      Saved_GM  : constant Ghost_Mode_Type := Ghost_Mode;
+      Saved_IGR : constant Node_Id         := Ignored_Ghost_Region;
+      --  Save the Ghost-related attributes to restore on exit
+
       T1 : Entity_Id;
       T2 : Entity_Id;
 
       Save_Full_Analysis : Boolean := False;
       --  Force initialization to facilitate static analysis
 
-      Saved_GM  : constant Ghost_Mode_Type := Ghost_Mode;
-      Saved_IGR : constant Node_Id         := Ignored_Ghost_Region;
-      --  Save the Ghost-related attributes to restore on exit
-
    --  Start of processing for Analyze_Assignment
 
    begin
@@ -476,16 +476,12 @@ package body Sem_Ch5 is
          Checks => True,
          Modes  => True);
 
-      --  Analyze the target of the assignment first in case the expression
-      --  contains references to Ghost entities. The checks that verify the
-      --  proper use of a Ghost entity need to know the enclosing context.
-
-      Analyze (Lhs);
-
       --  An assignment statement is Ghost when the left hand side denotes a
       --  Ghost entity. Set the mode now to ensure that any nodes generated
       --  during analysis and expansion are properly marked as Ghost.
 
+      Mark_And_Set_Ghost_Assignment (N);
+
       if Has_Target_Names (N) then
          Current_Assignment := N;
          Expander_Mode_Save_And_Set (False);
@@ -495,7 +491,7 @@ package body Sem_Ch5 is
          Current_Assignment := Empty;
       end if;
 
-      Mark_And_Set_Ghost_Assignment (N);
+      Analyze (Lhs);
       Analyze (Rhs);
 
       --  Ensure that we never do an assignment on a variable marked as

gcc/ada/sem_ch8.ads

@@ -82,7 +82,11 @@ package Sem_Ch8 is
    --  Subsidiaries of End_Use_Clauses. Also called directly for use clauses
    --  appearing in context clauses.
 
-   procedure Find_Direct_Name (N : Node_Id);
+   procedure Find_Direct_Name
+     (N            : Node_Id;
+      Errors_OK    : Boolean := True;
+      Marker_OK    : Boolean := True;
+      Reference_OK : Boolean := True);
    --  Given a direct name (Identifier or Operator_Symbol), this routine scans
    --  the homonym chain for the name, searching for corresponding visible
    --  entities to find the referenced entity (or in the case of overloading,
@@ -99,6 +103,11 @@ package Sem_Ch8 is
    --  entries in the current scope, and that will give all homonyms that are
    --  declared before the point of call in the current scope. This is useful
    --  for example in the processing for pragma Inline.
+   --
+   --  Flag Errors_OK should be set when error diagnostics are desired. Flag
+   --  Marker_OK should be set when a N_Variable_Reference_Marker needs to be
+   --  generated for a SPARK object in order to detect elaboration issues. Flag
+   --  Reference_OK should be set when N must generate a cross reference.
 
    procedure Find_Selected_Component (N : Node_Id);
    --  Resolve various cases of selected components, recognize expanded names

gcc/ada/sem_util.adb

@@ -25269,6 +25269,26 @@ package body Sem_Util is
       end if;
    end Type_Without_Stream_Operation;
 
+   ---------------------
+   -- Ultimate_Prefix --
+   ---------------------
+
+   function Ultimate_Prefix (N : Node_Id) return Node_Id is
+      Pref : Node_Id;
+
+   begin
+      Pref := N;
+      while Nkind_In (Pref, N_Explicit_Dereference,
+                            N_Indexed_Component,
+                            N_Selected_Component,
+                            N_Slice)
+      loop
+         Pref := Prefix (Pref);
+      end loop;
+
+      return Pref;
+   end Ultimate_Prefix;
+
    ----------------------------
    -- Unique_Defining_Entity --
    ----------------------------

gcc/ada/sem_util.ads

@@ -2810,6 +2810,10 @@ package Sem_Util is
    --  prevents the construction of a composite stream operation. If Op is
    --  specified we check only for the given stream operation.
 
+   function Ultimate_Prefix (N : Node_Id) return Node_Id;
+   --  Obtain the "outermost" prefix of arbitrary node N. Return N if no such
+   --  prefix exists.
+
    function Unique_Defining_Entity (N : Node_Id) return Entity_Id;
    --  Return the entity that represents declaration N, so that different
    --  views of the same entity have the same unique defining entity: