[COMMITTED] ada: Implement inheritance of user-defined literal aspects for untagged types

[COMMITTED] ada: Implement inheritance of user-defined literal aspects for untagged types

[Marc Poulhiès]

From: Eric Botcazou <ebotcazou@adacore.com>

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.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/sem_res.adb  |  1 -
 gcc/ada/sem_util.adb | 39 +++++++++++++++++++++++++++++++++++----
 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.
 
-- 
2.40.0