From: Piotr Trojanek <troja...@adacore.com>
Detection of ghost entities work similarly for names of objects (in assignment
statements) and for names of subprograms (in subprogram calls). Tune routine
name and its comment to match this similarity.
gcc/ada/ChangeLog:
* sem_util.ads (Get_Enclosing_Ghost_Entity): Rename spec.
* sem_util.adb (Get_Enclosing_Ghost_Object): Rename body; reorder
alphabetically; adapt recursive call.
* ghost.adb: Adapt calls to Get_Enclosing_Ghost_Object.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/ghost.adb | 14 ++++-----
gcc/ada/sem_util.adb | 74 ++++++++++++++++++++++----------------------
gcc/ada/sem_util.ads | 10 +++---
3 files changed, 48 insertions(+), 50 deletions(-)
diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb
index ac38f3cc239..6f648f2af92 100644
--- a/gcc/ada/ghost.adb
+++ b/gcc/ada/ghost.adb
@@ -776,7 +776,7 @@ package body Ghost is
Formal : Entity_Id;
Is_Default : Boolean := False)
is
- Actual_Obj : constant Entity_Id := Get_Enclosing_Ghost_Object (Actual);
+ Actual_Obj : constant Entity_Id := Get_Enclosing_Ghost_Entity (Actual);
begin
if not Is_Ghost_Entity (Formal) then
return;
@@ -1165,7 +1165,7 @@ package body Ghost is
-- entity.
if Nkind (N) = N_Assignment_Statement then
- Id := Get_Enclosing_Ghost_Object (Name (N));
+ Id := Get_Enclosing_Ghost_Entity (Name (N));
return Present (Id) and then Is_Ghost_Entity (Id);
end if;
@@ -1223,7 +1223,7 @@ package body Ghost is
-- A procedure call is Ghost when it invokes a Ghost procedure
if Nkind (N) = N_Procedure_Call_Statement then
- Id := Get_Enclosing_Ghost_Object (Name (N));
+ Id := Get_Enclosing_Ghost_Entity (Name (N));
return Present (Id) and then Is_Ghost_Entity (Id);
end if;
@@ -1460,7 +1460,7 @@ package body Ghost is
end if;
declare
- Id : constant Entity_Id := Get_Enclosing_Ghost_Object (Lhs);
+ Id : constant Entity_Id := Get_Enclosing_Ghost_Entity (Lhs);
begin
if Present (Id) then
-- Left-hand side denotes a Checked ghost entity, so install
@@ -1744,7 +1744,7 @@ package body Ghost is
-- A procedure call becomes Ghost when the procedure being invoked is
-- Ghost. Install the Ghost mode of the procedure.
- Id := Get_Enclosing_Ghost_Object (Name (N));
+ Id := Get_Enclosing_Ghost_Entity (Name (N));
if Present (Id) then
if Is_Checked_Ghost_Entity (Id) then
@@ -2058,7 +2058,7 @@ package body Ghost is
-- of the target.
if Nkind (N) = N_Assignment_Statement then
- Id := Get_Enclosing_Ghost_Object (Name (N));
+ Id := Get_Enclosing_Ghost_Entity (Name (N));
if Present (Id) then
Set_Ghost_Mode_From_Entity (Id);
@@ -2097,7 +2097,7 @@ package body Ghost is
-- procedure being invoked.
elsif Nkind (N) = N_Procedure_Call_Statement then
- Id := Get_Enclosing_Ghost_Object (Name (N));
+ Id := Get_Enclosing_Ghost_Entity (Name (N));
if Present (Id) then
Set_Ghost_Mode_From_Entity (Id);
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index e1b78dce32f..3c2a776ce36 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10261,6 +10261,43 @@ package body Sem_Util is
Strval => String_From_Name_Buffer);
end Get_Default_External_Name;
+ --------------------------------
+ -- Get_Enclosing_Ghost_Entity --
+ --------------------------------
+
+ function Get_Enclosing_Ghost_Entity (N : Node_Id) return Entity_Id is
+ begin
+ if Is_Entity_Name (N) then
+ return Entity (N);
+ else
+ case Nkind (N) is
+ when N_Attribute_Reference
+ | N_Explicit_Dereference
+ | N_Indexed_Component
+ | N_Selected_Component
+ | N_Slice
+ =>
+ return Get_Enclosing_Ghost_Entity (Prefix (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_Ghost_Entity;
+
--------------------------
-- Get_Enclosing_Object --
--------------------------
@@ -10286,43 +10323,6 @@ package body Sem_Util is
end if;
end Get_Enclosing_Object;
- --------------------------------
- -- Get_Enclosing_Ghost_Object --
- --------------------------------
-
- 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_Attribute_Reference
- | N_Explicit_Dereference
- | N_Indexed_Component
- | N_Selected_Component
- | N_Slice
- =>
- return Get_Enclosing_Ghost_Object (Prefix (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_Ghost_Object;
-
---------------------------
-- Get_Enum_Lit_From_Pos --
---------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index c2c689abd63..6e458664864 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1143,12 +1143,10 @@ 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_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. Also, it handles function results and type conversions like
- -- objects. Expression N should have been resolved already.
+ function Get_Enclosing_Ghost_Entity (N : Node_Id) return Entity_Id;
+ -- If expression N references a name of either an object or of a
+ -- subprogram, then return its outermost entity that determines
+ -- whether this name denotes a ghost object.
function Get_Generic_Entity (N : Node_Id) return Entity_Id;
-- Returns the true generic entity in an instantiation. If the name in the
--
2.43.0
