diff options
author | Eric Botcazou <ebotcazou@adacore.com> | 2023-01-28 00:08:24 +0100 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2023-05-16 10:30:58 +0200 |
commit | bac7eb85ef0caca4e55b362f688776dbea14feb9 (patch) | |
tree | bf09d1c352198227391f0d5d262541302a9c030f | |
parent | 072861beb9bcc6cbf2e16aafe6b0aae049d60989 (diff) | |
download | gcc-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.adb | 1 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 39 | ||||
-rw-r--r-- | gcc/ada/sem_util.ads | 6 |
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. |