https://gcc.gnu.org/g:d47dc1143c2e93414051b97f94bb648f855a20a2
commit r16-1801-gd47dc1143c2e93414051b97f94bb648f855a20a2
Author: Piotr Trojanek <troja...@adacore.com>
Date: Fri Apr 18 16:43:38 2025 +0200
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:
---
gcc/ada/ghost.adb | 62 +++++++++++++---------------------------------------
gcc/ada/sem_util.adb | 29 ++++++++++++++++--------
gcc/ada/sem_util.ads | 5 +++--
3 files changed, 38 insertions(+), 58 deletions(-)
diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb
index 314a13deba87..2c61f3a80abd 100644
--- 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 5322dea410b1..e1b78dce32fe 100644
--- 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 8d5bda013faf..c2c689abd630 100644
--- 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
