ada: Fix detection of ghost objects in assignment statements

Remove duplicated and inconsistent code for detecting ghost objects on the
left-hand side of assignment statements. Fix detection in the presence of
attribute references (e.g. "X'Access.all"), function calls (e.g. "F.all"),
qualified expressions (e.g. "T'(new Integer'(0)).all") and unchecked type
conversions (which come from expansion).

gcc/ada/ChangeLog:

	* ghost.adb
	(Whole_Object_Ref): Remove; use Get_Enclosing_Ghost_Object instead.
	(Is_Ghost_Assignment): Handle more than object identifiers.
	(Mark_And_Set_Ghost_Assignment): Likewise.
	* sem_util.adb (Get_Enclosing_Ghost_Object): Detect more expressions
	as ghost references; rename to better match the intended meaning.
	* sem_util.ads (Get_Enclosing_Ghost_Object): Rename; adjust comment.

diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb
index 314a13deba875cf56f995ae70f891dc779d2f85d..2c61f3a80abd72183e653c804f326bd7207af603 100644 (file)
--- a/gcc/ada/ghost.adb
+++ b/gcc/ada/ghost.adb
@@ -67,12 +67,6 @@ package body Ghost is
    -- Local subprograms --
    -----------------------
 
-   function Whole_Object_Ref (Ref : Node_Id) return Node_Id;
-   --  For a name that denotes an object, returns a name that denotes the whole
-   --  object, declared by an object declaration, formal parameter declaration,
-   --  etc. For example, for P.X.Comp (J), if P is a package X is a record
-   --  object, this returns P.X.
-
    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
@@ -787,7 +781,7 @@ package body Ghost is
       Formal     : Entity_Id;
       Is_Default : Boolean := False)
    is
-      Actual_Obj : constant Entity_Id := Get_Enclosing_Deep_Object (Actual);
+      Actual_Obj : constant Entity_Id := Get_Enclosing_Ghost_Object (Actual);
    begin
       if not Is_Ghost_Entity (Formal) then
          return;
@@ -1197,7 +1191,7 @@ package body Ghost is
       --  entity.
 
       if Nkind (N) = N_Assignment_Statement then
-         Id := Ghost_Entity (Name (N));
+         Id := Get_Enclosing_Ghost_Object (Name (N));
 
          return Present (Id) and then Is_Ghost_Entity (Id);
       end if;
@@ -1492,29 +1486,23 @@ package body Ghost is
             end if;
 
             declare
-               Whole : constant Node_Id := Whole_Object_Ref (Lhs);
-               Id    : Entity_Id;
+               Id : constant Entity_Id := Get_Enclosing_Ghost_Object (Lhs);
             begin
-               if Is_Entity_Name (Whole) then
-                  Id := Entity (Whole);
+               if Present (Id) then
+                  --  Left-hand side denotes a Checked ghost entity, so install
+                  --  the region.
 
-                  if Present (Id) then
-                     --  Left-hand side denotes a Checked ghost entity, so
-                     --  install the region.
+                  if Is_Checked_Ghost_Entity (Id) then
+                     Install_Ghost_Region (Check, N);
 
-                     if Is_Checked_Ghost_Entity (Id) then
-                        Install_Ghost_Region (Check, N);
+                  --  Left-hand side denotes an Ignored ghost entity, so
+                  --  install the region, and mark the assignment statement as
+                  --  an ignored ghost assignment, so it will be removed later.
 
-                     --  Left-hand side denotes an Ignored ghost entity, so
-                     --  install the region, and mark the assignment statement
-                     --  as an ignored ghost assignment, so it will be removed
-                     --  later.
-
-                     elsif Is_Ignored_Ghost_Entity (Id) then
-                        Install_Ghost_Region (Ignore, N);
-                        Set_Is_Ignored_Ghost_Node (N);
-                        Record_Ignored_Ghost_Node (N);
-                     end if;
+                  elsif Is_Ignored_Ghost_Entity (Id) then
+                     Install_Ghost_Region (Ignore, N);
+                     Set_Is_Ignored_Ghost_Node (N);
+                     Record_Ignored_Ghost_Node (N);
                   end if;
                end if;
             end;
@@ -2157,24 +2145,4 @@ package body Ghost is
       end if;
    end Set_Is_Ghost_Entity;
 
-   ----------------------
-   -- Whole_Object_Ref --
-   ----------------------
-
-   function Whole_Object_Ref (Ref : Node_Id) return Node_Id is
-   begin
-      if Nkind (Ref) in N_Indexed_Component | N_Slice
-        or else (Nkind (Ref) = N_Selected_Component
-                   and then Is_Object_Reference (Prefix (Ref)))
-      then
-         if Is_Access_Type (Etype (Prefix (Ref))) then
-            return Ref;
-         else
-            return Whole_Object_Ref (Prefix (Ref));
-         end if;
-      else
-         return Ref;
-      end if;
-   end Whole_Object_Ref;
-
 end Ghost;

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 5322dea410b1fa6a1f75dbbcfa137a0680aebc9a..e1b78dce32feca04db134394f533b54f3714ff17 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10286,31 +10286,42 @@ package body Sem_Util is
       end if;
    end Get_Enclosing_Object;
 
-   -------------------------------
-   -- Get_Enclosing_Deep_Object --
-   -------------------------------
+   --------------------------------
+   -- Get_Enclosing_Ghost_Object --
+   --------------------------------
 
-   function Get_Enclosing_Deep_Object (N : Node_Id) return Entity_Id is
+   function Get_Enclosing_Ghost_Object (N : Node_Id) return Entity_Id is
    begin
       if Is_Entity_Name (N) then
          return Entity (N);
       else
          case Nkind (N) is
-            when N_Explicit_Dereference
+            when N_Attribute_Reference
+               | N_Explicit_Dereference
                | N_Indexed_Component
                | N_Selected_Component
                | N_Slice
             =>
-               return Get_Enclosing_Deep_Object (Prefix (N));
+               return Get_Enclosing_Ghost_Object (Prefix (N));
 
-            when N_Type_Conversion =>
-               return Get_Enclosing_Deep_Object (Expression (N));
+            when N_Function_Call =>
+               return Get_Called_Entity (N);
+
+            --  We are interested in the target type, because if it is ghost,
+            --  then the object is ghost as well and if it is non-ghost, then
+            --  its expression can't be ghost.
+
+            when N_Qualified_Expression
+               | N_Type_Conversion
+               | N_Unchecked_Type_Conversion
+            =>
+               return Entity (Subtype_Mark (N));
 
             when others =>
                return Empty;
          end case;
       end if;
-   end Get_Enclosing_Deep_Object;
+   end Get_Enclosing_Ghost_Object;
 
    ---------------------------
    -- Get_Enum_Lit_From_Pos --

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 8d5bda013faf0796b01ac044939fc387c155d4ff..c2c689abd6300bcdbead13dc9ba00e28836c2790 100644 (file)
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1143,11 +1143,12 @@ package Sem_Util is
    --  If expression N references a part of an object, return this object.
    --  Otherwise return Empty. Expression N should have been resolved already.
 
-   function Get_Enclosing_Deep_Object (N : Node_Id) return Entity_Id;
+   function Get_Enclosing_Ghost_Object (N : Node_Id) return Entity_Id;
    --  If expression N references a reachable part of an object (as defined in
    --  SPARK RM 6.9), return this object. Otherwise return Empty. It is similar
    --  to Get_Enclosing_Object, but treats pointer dereference like component
-   --  selection. Expression N should have been resolved already.
+   --  selection. Also, it handles function results and type conversions like
+   --  objects. Expression N should have been resolved already.
 
    function Get_Generic_Entity (N : Node_Id) return Entity_Id;
    --  Returns the true generic entity in an instantiation. If the name in the