[gcc r16-2402] ada: exp_util.adb: prevent infinite loop in case of broken code

[Marc Poulhies via Gcc-cvs]

https://gcc.gnu.org/g:83219c97fabc1c0a8e0c42ad3d023706b8132827

commit r16-2402-g83219c97fabc1c0a8e0c42ad3d023706b8132827
Author: Ghjuvan Lacambre <lacam...@adacore.com>
Date:   Wed Jul 2 09:11:03 2025 +0200

    ada: exp_util.adb: prevent infinite loop in case of broken code
    
    A recent commit modified exp_util.adb in order to fix the selection of
    Finalize subprograms in the case of untagged objects.
    This introduced regressions for GNATSAS in fixedbugs by causing
    GNAT2SCIL to loop over the same type over and over in case of broken
    code.
    We fix this by simply checking that the loop is making progress, and if
    it doesn't, assume that we're done.
    
    gcc/ada/ChangeLog:
    
            * exp_util.adb (Finalize_Address): Prevent infinite loop

Diff:
---
 gcc/ada/exp_util.adb | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 2172ce75709e..80e9a8101166 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6191,12 +6191,17 @@ package body Exp_Util is
 
          else
             declare
-               Root : constant Entity_Id := Underlying_Type (Root_Type (Btyp));
+               Root      : constant Entity_Id :=
+                 Underlying_Type (Root_Type (Btyp));
+               Prev_Utyp : Entity_Id := Empty;
             begin
                if Is_Protected_Type (Root) then
                   Utyp := Corresponding_Record_Type (Root);
                else
-                  while No (TSS (Utyp, TSS_Finalize_Address)) loop
+                  while No (TSS (Utyp, TSS_Finalize_Address))
+                    and then Utyp /= Prev_Utyp
+                  loop
+                     Prev_Utyp := Utyp;
                      Utyp := Underlying_Type (Base_Type (Etype (Utyp)));
                   end loop;
                end if;