public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/autopar_devel] [Ada] universal_access equality and 'Access attributes
@ 2020-08-22 22:51 Giuliano Belinassi
0 siblings, 0 replies; only message in thread
From: Giuliano Belinassi @ 2020-08-22 22:51 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:d288fb8eac42f675d11267297137181c4f22ff9f
commit d288fb8eac42f675d11267297137181c4f22ff9f
Author: Arnaud Charlet <charlet@adacore.com>
Date: Sun Apr 26 06:08:29 2020 -0400
[Ada] universal_access equality and 'Access attributes
2020-06-19 Arnaud Charlet <charlet@adacore.com>
gcc/ada/
* sem_ch4.adb (Find_Equality_Types.Check_Access_Attribute): New.
(Find_Equality_Types): Move universal_access related checks at
the end of the processing and add call to
Check_Access_Attribute.
Diff:
---
gcc/ada/sem_ch4.adb | 63 +++++++++++++++++++++++++++++++++++++++++------------
1 file changed, 49 insertions(+), 14 deletions(-)
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index fa231358a2c..0f59b40c62a 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -6540,12 +6540,24 @@ package body Sem_Ch4 is
Op_Id : Entity_Id;
N : Node_Id)
is
- Index : Interp_Index := 0;
- It : Interp;
- Found : Boolean := False;
- I_F : Interp_Index;
- T_F : Entity_Id;
- Scop : Entity_Id := Empty;
+ Index : Interp_Index := 0;
+ It : Interp;
+ Found : Boolean := False;
+ Is_Universal_Access : Boolean := False;
+ I_F : Interp_Index;
+ T_F : Entity_Id;
+ Scop : Entity_Id := Empty;
+
+ procedure Check_Access_Attribute (N : Node_Id);
+ -- For any object, '[Unchecked_]Access of such object can never be
+ -- passed as a parameter of a call to the Universal_Access equality
+ -- operator.
+ -- This is because the expected type for Obj'Access in a call to
+ -- the Standard."=" operator whose formals are of type
+ -- Universal_Access is Universal_Integer, and Universal_Access
+ -- doesn't have a designated type. For more detail see RM 6.4.1(3)
+ -- and 3.10.2.
+ -- This procedure assumes that the context is a universal_access.
function Check_Access_Object_Types
(N : Node_Id; Typ : Entity_Id) return Boolean;
@@ -6574,6 +6586,23 @@ package body Sem_Ch4 is
-- and an error can be emitted now, after trying to disambiguate, i.e.
-- applying preference rules.
+ ----------------------------
+ -- Check_Access_Attribute --
+ ----------------------------
+
+ procedure Check_Access_Attribute (N : Node_Id) is
+ begin
+ if Nkind (N) = N_Attribute_Reference
+ and then Nam_In (Attribute_Name (N),
+ Name_Access,
+ Name_Unchecked_Access)
+ then
+ Error_Msg_N
+ ("access attribute cannot be used as actual for "
+ & "universal_access equality", N);
+ end if;
+ end Check_Access_Attribute;
+
-------------------------------
-- Check_Access_Object_Types --
-------------------------------
@@ -6867,14 +6896,6 @@ package body Sem_Ch4 is
and then (not Universal_Access
or else Check_Access_Object_Types (R, T1))
then
- if Universal_Access
- and then Is_Access_Subprogram_Type (T1)
- and then Nkind (L) /= N_Null
- and then Nkind (R) /= N_Null
- then
- Check_Compatible_Profiles (R, T1);
- end if;
-
if Found
and then Base_Type (T1) /= Base_Type (T_F)
then
@@ -6887,12 +6908,14 @@ package body Sem_Ch4 is
else
T_F := It.Typ;
+ Is_Universal_Access := Universal_Access;
end if;
else
Found := True;
T_F := T1;
I_F := Index;
+ Is_Universal_Access := Universal_Access;
end if;
if not Analyzed (L) then
@@ -6947,6 +6970,18 @@ package body Sem_Ch4 is
Get_Next_Interp (Index, It);
end loop;
end if;
+
+ if Is_Universal_Access then
+ if Is_Access_Subprogram_Type (Etype (L))
+ and then Nkind (L) /= N_Null
+ and then Nkind (R) /= N_Null
+ then
+ Check_Compatible_Profiles (R, Etype (L));
+ end if;
+
+ Check_Access_Attribute (R);
+ Check_Access_Attribute (L);
+ end if;
end Find_Equality_Types;
-------------------------
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-08-22 22:51 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-08-22 22:51 [gcc/devel/autopar_devel] [Ada] universal_access equality and 'Access attributes Giuliano Belinassi
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).