[gcc r15-9925] ada: Fix selection of Finalize subprogram in untagged case

[Eric Botcazou via Gcc-cvs]

https://gcc.gnu.org/g:7b4e397c5790055d7791fc341b87f7fb35ff2d6c

commit r15-9925-g7b4e397c5790055d7791fc341b87f7fb35ff2d6c
Author: Ronan Desplanques <desplanq...@adacore.com>
Date:   Fri Jun 20 09:59:36 2025 +0200

    ada: Fix selection of Finalize subprogram in untagged case
    
    The newly introduced Finalizable aspect makes it possible to derive from
    a type that is not tagged but has a Finalize primitive. This patch fixes
    problems where overridings of the Finalize primitive were ignored.
    
    gcc/ada/ChangeLog:
    
            * exp_ch7.adb (Make_Final_Call): Tweak search of Finalize primitive.
            * exp_util.adb (Finalize_Address): Likewise.

Diff:
---
 gcc/ada/exp_ch7.adb  | 14 +++++++++-----
 gcc/ada/exp_util.adb | 16 +++++++++++-----
 2 files changed, 20 insertions(+), 10 deletions(-)

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 41438f40a888..0f534af8a32f 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -7906,12 +7906,16 @@ package body Exp_Ch7 is
       if Is_Untagged_Derivation (Typ) then
          if Is_Protected_Type (Typ) then
             Utyp := Corresponding_Record_Type (Root_Type (Base_Type (Typ)));
-         else
-            Utyp := Underlying_Type (Root_Type (Base_Type (Typ)));
 
-            if Is_Protected_Type (Utyp) then
-               Utyp := Corresponding_Record_Type (Utyp);
-            end if;
+         else
+            declare
+               Root : constant Entity_Id :=
+                 Underlying_Type (Root_Type (Base_Type (Typ)));
+            begin
+               if Is_Protected_Type (Root) then
+                  Utyp := Corresponding_Record_Type (Root);
+               end if;
+            end;
          end if;
 
          Ref := Unchecked_Convert_To (Utyp, Ref);
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index f225e179b234..90de6962a1bc 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6080,11 +6080,17 @@ package body Exp_Util is
             Utyp := Corresponding_Record_Type (Root_Type (Btyp));
 
          else
-            Utyp := Underlying_Type (Root_Type (Btyp));
-
-            if Is_Protected_Type (Utyp) then
-               Utyp := Corresponding_Record_Type (Utyp);
-            end if;
+            declare
+               Root : constant Entity_Id := Underlying_Type (Root_Type (Btyp));
+            begin
+               if Is_Protected_Type (Root) then
+                  Utyp := Corresponding_Record_Type (Root);
+               else
+                  while No (TSS (Utyp, TSS_Finalize_Address)) loop
+                     Utyp := Underlying_Type (Base_Type (Etype (Utyp)));
+                  end loop;
+               end if;
+            end;
          end if;
       end if;