* [Ada] Fix detection of overlapping actuals with renamings
@ 2021-06-18 8:38 Pierre-Marie de Rodat
0 siblings, 0 replies; 2+ messages in thread
From: Pierre-Marie de Rodat @ 2021-06-18 8:38 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
[-- Attachment #1: Type: text/plain, Size: 549 bytes --]
Routine Denotes_Same_Object wrongly handled renamings of renamings. In a
code like this:
B : Integer renames A;
C : Integer renames B;
names "B" and "C" differ and their renamed object names "A" and "B"
differ too. This patch rewrites this routine to literally follow the RM,
which fixes the problem with renamings.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_util.adb (Denotes_Same_Object): Explicitly test for node
kinds being the same; deal with renamings one-by-one; adjust
numbers in references to the Ada RM.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 7381 bytes --]
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -7388,84 +7388,46 @@ package body Sem_Util is
return True;
end Is_Valid_Renaming;
- -- Local variables
-
- Obj1 : Node_Id := A1;
- Obj2 : Node_Id := A2;
-
-- Start of processing for Denotes_Same_Object
begin
- -- Both names statically denote the same stand-alone object or parameter
- -- (RM 6.4.1(6.5/3))
+ -- Both names statically denote the same stand-alone object or
+ -- parameter (RM 6.4.1(6.6/3)).
- if Is_Entity_Name (Obj1)
- and then Is_Entity_Name (Obj2)
- and then Entity (Obj1) = Entity (Obj2)
+ if Is_Entity_Name (A1)
+ and then Is_Entity_Name (A2)
+ and then Entity (A1) = Entity (A2)
then
return True;
- end if;
-
- -- For renamings, the prefix of any dereference within the renamed
- -- object_name is not a variable, and any expression within the
- -- renamed object_name contains no references to variables nor
- -- calls on nonstatic functions (RM 6.4.1(6.10/3)).
-
- if Is_Renaming (Obj1) then
- if Is_Valid_Renaming (Obj1) then
- Obj1 := Renamed_Entity (Entity (Obj1));
- else
- return False;
- end if;
- end if;
-
- if Is_Renaming (Obj2) then
- if Is_Valid_Renaming (Obj2) then
- Obj2 := Renamed_Entity (Entity (Obj2));
- else
- return False;
- end if;
- end if;
-
- -- No match if not same node kind (such cases are handled by
- -- Denotes_Same_Prefix)
-
- if Nkind (Obj1) /= Nkind (Obj2) then
- return False;
-
- -- After handling valid renamings, one of the two names statically
- -- denoted a renaming declaration whose renamed object_name is known
- -- to denote the same object as the other (RM 6.4.1(6.10/3))
-
- elsif Is_Entity_Name (Obj1) then
- if Is_Entity_Name (Obj2) then
- return Entity (Obj1) = Entity (Obj2);
- else
- return False;
- end if;
-- Both names are selected_components, their prefixes are known to
-- denote the same object, and their selector_names denote the same
- -- component (RM 6.4.1(6.6/3)).
+ -- component (RM 6.4.1(6.7/3)).
- elsif Nkind (Obj1) = N_Selected_Component then
- return Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2))
+ elsif Nkind (A1) = N_Selected_Component
+ and then Nkind (A2) = N_Selected_Component
+ then
+ return Denotes_Same_Object (Prefix (A1), Prefix (A2))
and then
- Entity (Selector_Name (Obj1)) = Entity (Selector_Name (Obj2));
+ Entity (Selector_Name (A1)) = Entity (Selector_Name (A2));
-- Both names are dereferences and the dereferenced names are known to
- -- denote the same object (RM 6.4.1(6.7/3))
+ -- denote the same object (RM 6.4.1(6.8/3)).
- elsif Nkind (Obj1) = N_Explicit_Dereference then
- return Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2));
+ elsif Nkind (A1) = N_Explicit_Dereference
+ and then Nkind (A2) = N_Explicit_Dereference
+ then
+ return Denotes_Same_Object (Prefix (A1), Prefix (A2));
-- Both names are indexed_components, their prefixes are known to denote
-- the same object, and each of the pairs of corresponding index values
-- are either both static expressions with the same static value or both
- -- names that are known to denote the same object (RM 6.4.1(6.8/3))
+ -- names that are known to denote the same object (RM 6.4.1(6.9/3)).
- elsif Nkind (Obj1) = N_Indexed_Component then
- if not Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2)) then
+ elsif Nkind (A1) = N_Indexed_Component
+ and then Nkind (A2) = N_Indexed_Component
+ then
+ if not Denotes_Same_Object (Prefix (A1), Prefix (A2)) then
return False;
else
declare
@@ -7473,8 +7435,8 @@ package body Sem_Util is
Indx2 : Node_Id;
begin
- Indx1 := First (Expressions (Obj1));
- Indx2 := First (Expressions (Obj2));
+ Indx1 := First (Expressions (A1));
+ Indx2 := First (Expressions (A2));
while Present (Indx1) loop
-- Indexes must denote the same static value or same object
@@ -7501,33 +7463,53 @@ package body Sem_Util is
-- Both names are slices, their prefixes are known to denote the same
-- object, and the two slices have statically matching index constraints
- -- (RM 6.4.1(6.9/3))
+ -- (RM 6.4.1(6.10/3)).
- elsif Nkind (Obj1) = N_Slice
- and then Denotes_Same_Object (Prefix (Obj1), Prefix (Obj2))
+ elsif Nkind (A1) = N_Slice
+ and then Nkind (A2) = N_Slice
then
- declare
- Lo1, Lo2, Hi1, Hi2 : Node_Id;
+ if not Denotes_Same_Object (Prefix (A1), Prefix (A2)) then
+ return False;
+ else
+ declare
+ Lo1, Lo2, Hi1, Hi2 : Node_Id;
- begin
- Get_Index_Bounds (Discrete_Range (Obj1), Lo1, Hi1);
- Get_Index_Bounds (Discrete_Range (Obj2), Lo2, Hi2);
+ begin
+ Get_Index_Bounds (Discrete_Range (A1), Lo1, Hi1);
+ Get_Index_Bounds (Discrete_Range (A2), Lo2, Hi2);
- -- Check whether bounds are statically identical. There is no
- -- attempt to detect partial overlap of slices.
+ -- Check whether bounds are statically identical. There is no
+ -- attempt to detect partial overlap of slices.
- return Denotes_Same_Object (Lo1, Lo2)
- and then
- Denotes_Same_Object (Hi1, Hi2);
- end;
+ return Denotes_Same_Object (Lo1, Lo2)
+ and then
+ Denotes_Same_Object (Hi1, Hi2);
+ end;
+ end if;
- -- In the recursion, literals appear as indexes
+ -- One of the two names statically denotes a renaming declaration whose
+ -- renamed object_name is known to denote the same object as the other;
+ -- the prefix of any dereference within the renamed object_name is not a
+ -- variable, and any expression within the renamed object_name contains
+ -- no references to variables nor calls on nonstatic functions (RM
+ -- 6.4.1(6.11/3)).
- elsif Nkind (Obj1) = N_Integer_Literal
- and then
- Nkind (Obj2) = N_Integer_Literal
+ elsif Is_Renaming (A1)
+ and then Is_Valid_Renaming (A1)
+ then
+ return Denotes_Same_Object (Renamed_Entity (Entity (A1)), A2);
+
+ elsif Is_Renaming (A2)
+ and then Is_Valid_Renaming (A2)
+ then
+ return Denotes_Same_Object (A1, Renamed_Entity (Entity (A2)));
+
+ -- In the recursion, literals appear as slice bounds
+
+ elsif Nkind (A1) = N_Integer_Literal
+ and then Nkind (A2) = N_Integer_Literal
then
- return Intval (Obj1) = Intval (Obj2);
+ return Intval (A1) = Intval (A2);
else
return False;
^ permalink raw reply [flat|nested] 2+ messages in thread
* [Ada] Fix detection of overlapping actuals with renamings
@ 2021-06-21 11:05 Pierre-Marie de Rodat
0 siblings, 0 replies; 2+ messages in thread
From: Pierre-Marie de Rodat @ 2021-06-21 11:05 UTC (permalink / raw)
To: gcc-patches; +Cc: Piotr Trojanek
[-- Attachment #1: Type: text/plain, Size: 346 bytes --]
Simplify detection of renamings within actuals that denote the same
object. This code only needs to take object renamings and shouldn't care
about renamings of subprogram, packages or exceptions.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_util.adb (Is_Object_Renaming): Rename from Is_Renaming;
simplify; adapt callers.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 2935 bytes --]
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -7262,8 +7262,8 @@ package body Sem_Util is
-------------------------
function Denotes_Same_Object (A1, A2 : Node_Id) return Boolean is
- function Is_Renaming (N : Node_Id) return Boolean;
- -- Return true if N names a renaming entity
+ function Is_Object_Renaming (N : Node_Id) return Boolean;
+ -- Return true if N names an object renaming entity
function Is_Valid_Renaming (N : Node_Id) return Boolean;
-- For renamings, return False if the prefix of any dereference within
@@ -7271,35 +7271,16 @@ package body Sem_Util is
-- renamed object_name contains references to variables or calls on
-- nonstatic functions; otherwise return True (RM 6.4.1(6.10/3))
- -----------------
- -- Is_Renaming --
- -----------------
+ ------------------------
+ -- Is_Object_Renaming --
+ ------------------------
- function Is_Renaming (N : Node_Id) return Boolean is
+ function Is_Object_Renaming (N : Node_Id) return Boolean is
begin
- if not Is_Entity_Name (N) then
- return False;
- end if;
-
- case Ekind (Entity (N)) is
- when E_Variable | E_Constant =>
- return Present (Renamed_Object (Entity (N)));
-
- when E_Exception
- | E_Function
- | E_Generic_Function
- | E_Generic_Package
- | E_Generic_Procedure
- | E_Operator
- | E_Package
- | E_Procedure
- =>
- return Present (Renamed_Entity (Entity (N)));
-
- when others =>
- return False;
- end case;
- end Is_Renaming;
+ return Is_Entity_Name (N)
+ and then Ekind (Entity (N)) in E_Variable | E_Constant
+ and then Present (Renamed_Object (Entity (N)));
+ end Is_Object_Renaming;
-----------------------
-- Is_Valid_Renaming --
@@ -7307,7 +7288,7 @@ package body Sem_Util is
function Is_Valid_Renaming (N : Node_Id) return Boolean is
begin
- if Is_Renaming (N)
+ if Is_Object_Renaming (N)
and then not Is_Valid_Renaming (Renamed_Entity (Entity (N)))
then
return False;
@@ -7494,12 +7475,12 @@ package body Sem_Util is
-- no references to variables nor calls on nonstatic functions (RM
-- 6.4.1(6.11/3)).
- elsif Is_Renaming (A1)
+ elsif Is_Object_Renaming (A1)
and then Is_Valid_Renaming (A1)
then
return Denotes_Same_Object (Renamed_Entity (Entity (A1)), A2);
- elsif Is_Renaming (A2)
+ elsif Is_Object_Renaming (A2)
and then Is_Valid_Renaming (A2)
then
return Denotes_Same_Object (A1, Renamed_Entity (Entity (A2)));
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2021-06-21 11:05 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-06-18 8:38 [Ada] Fix detection of overlapping actuals with renamings Pierre-Marie de Rodat
2021-06-21 11:05 Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).