[COMMITTED 07/14] ada: Fix selection of Finalize subprogram in untagged case

[Marc Poulhiès]

From: Ronan Desplanques <desplanq...@adacore.com>

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.

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

---
 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 e4daf4bc7a3..009bee4bc6c 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 4f987790405..2172ce75709 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6190,11 +6190,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;
 
-- 
2.43.0