public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-1636] [Ada] Fix detection of overlapping actuals with renamings
@ 2021-06-18 8:39 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-06-18 8:39 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:cbe87f458252d3d25288d261703d79277943848e
commit r12-1636-gcbe87f458252d3d25288d261703d79277943848e
Author: Piotr Trojanek <trojanek@adacore.com>
Date: Tue Mar 23 01:00:50 2021 +0100
[Ada] Fix detection of overlapping actuals with renamings
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.
Diff:
---
gcc/ada/sem_util.adb | 142 ++++++++++++++++++++++-----------------------------
1 file changed, 62 insertions(+), 80 deletions(-)
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index eb2caa76407..44a4dc21f14 100644
--- 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] only message in thread
only message in thread, other threads:[~2021-06-18 8:39 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-06-18 8:39 [gcc r12-1636] [Ada] Fix detection of overlapping actuals with renamings 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).