summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2023-01-28 00:08:24 +0100
committerMarc Poulhiès <poulhies@adacore.com>2023-05-16 10:30:58 +0200
commitbac7eb85ef0caca4e55b362f688776dbea14feb9 (patch)
treebf09d1c352198227391f0d5d262541302a9c030f
parent072861beb9bcc6cbf2e16aafe6b0aae049d60989 (diff)
downloadgcc-bac7eb85ef0caca4e55b362f688776dbea14feb9.tar.gz
ada: Implement inheritance of user-defined literal aspects for untagged types
In Ada 2022, user-defined literal aspects are nonoverridable but the named subprograms present in them can be overridden, including for untagged types. gcc/ada/ * sem_res.adb (Has_Applicable_User_Defined_Literal): Apply the same processing for derived untagged types as for tagged types. * sem_util.ads (Corresponding_Primitive_Op): Adjust description. * sem_util.adb (Corresponding_Primitive_Op): Handle untagged types.
-rw-r--r--gcc/ada/sem_res.adb1
-rw-r--r--gcc/ada/sem_util.adb39
-rw-r--r--gcc/ada/sem_util.ads6
3 files changed, 38 insertions, 8 deletions
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index df9ccb18468..f6634da42a7 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -492,7 +492,6 @@ package body Sem_Res is
Name := Make_Identifier (Loc, Chars (Callee));
if Is_Derived_Type (Typ)
- and then Is_Tagged_Type (Typ)
and then Base_Type (Etype (Callee)) /= Base_Type (Typ)
then
Callee :=
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 38dc654f7be..1d8d4fc30f8 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -6483,9 +6483,8 @@ package body Sem_Util is
(Ancestor_Op : Entity_Id;
Descendant_Type : Entity_Id) return Entity_Id
is
- Typ : constant Entity_Id := Find_Dispatching_Type (Ancestor_Op);
- Elmt : Elmt_Id;
- Subp : Entity_Id;
+ function Find_Untagged_Type_Of (Prim : Entity_Id) return Entity_Id;
+ -- Search for the untagged type of the primitive operation Prim.
function Profile_Matches_Ancestor (S : Entity_Id) return Boolean;
-- Returns True if subprogram S has the proper profile for an
@@ -6493,6 +6492,34 @@ package body Sem_Util is
-- have the same type, or are corresponding controlling formals,
-- and similarly for result types).
+ ---------------------------
+ -- Find_Untagged_Type_Of --
+ ---------------------------
+
+ function Find_Untagged_Type_Of (Prim : Entity_Id) return Entity_Id is
+ E : Entity_Id := First_Entity (Scope (Prim));
+
+ begin
+ while Present (E) and then E /= Prim loop
+ if not Is_Tagged_Type (E)
+ and then Present (Direct_Primitive_Operations (E))
+ and then Contains (Direct_Primitive_Operations (E), Prim)
+ then
+ return E;
+ end if;
+
+ Next_Entity (E);
+ end loop;
+
+ pragma Assert (False);
+ return Empty;
+ end Find_Untagged_Type_Of;
+
+ Typ : constant Entity_Id :=
+ (if Is_Dispatching_Operation (Ancestor_Op)
+ then Find_Dispatching_Type (Ancestor_Op)
+ else Find_Untagged_Type_Of (Ancestor_Op));
+
------------------------------
-- Profile_Matches_Ancestor --
------------------------------
@@ -6529,10 +6556,14 @@ package body Sem_Util is
or else Is_Ancestor (Typ, Etype (S)));
end Profile_Matches_Ancestor;
+ -- Local variables
+
+ Elmt : Elmt_Id;
+ Subp : Entity_Id;
+
-- Start of processing for Corresponding_Primitive_Op
begin
- pragma Assert (Is_Dispatching_Operation (Ancestor_Op));
pragma Assert (Is_Ancestor (Typ, Descendant_Type)
or else Is_Progenitor (Typ, Descendant_Type));
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index f98e05615fd..42c6d249e2f 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -618,9 +618,9 @@ package Sem_Util is
-- Possible optimization???
function Corresponding_Primitive_Op
- (Ancestor_Op : Entity_Id;
- Descendant_Type : Entity_Id) return Entity_Id;
- -- Given a primitive subprogram of a tagged type and a (distinct)
+ (Ancestor_Op : Entity_Id;
+ Descendant_Type : Entity_Id) return Entity_Id;
+ -- Given a primitive subprogram of a first type and a (distinct)
-- descendant type of that type, find the corresponding primitive
-- subprogram of the descendant type.