commit e28f90fcc8d8eafcae7fe5bd3ea18cfc194e7d6b
author Ghjuvan Lacambre <lacambre@adacore.com> Wed Jul 02 09:11:03 2025 +0200
committer Eric Botcazou <ebotcazou@gcc.gnu.org> Tue Jul 22 12:08:40 2025 +0200
tree bc0c44feb1ba8dd1eb65050b961dcb43a6e2e337
parent 9023bcd0d68c1ba7faebc9edb6db34537b2a7966

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

gcc/ada/exp_util.adb

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 90de696..b3dbe98 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -6081,12 +6081,17 @@
 
          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;