From: Bob Duff <duff@adacore.com>
Date: Mon, 30 Jan 2023 16:25:08 +0000 (-0500)
Subject: ada: prevent infinite recursion in Collect_Types_In_Hierarchy
X-Git-Tag: basepoints/gcc-15~9108
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=df0ac6e158727064dd089be9051a82c26bd66880;p=thirdparty%2Fgcc.git

ada: prevent infinite recursion in Collect_Types_In_Hierarchy

In (illegal) mutually-dependent type declarations, it is possible for
Etype (Etype (Typ)) to point back to Typ. This patch stops the recursion
in such cases.

gcc/ada/

	* sem_util.adb (Process_Type): Stop the recursion.
	* exp_aggr.adb (Build_Record_Aggr_Code): Add assertion.
---

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index fe61e0ec90bf..58831bd51cad 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -3837,6 +3837,7 @@ package body Exp_Aggr is
       Comp := First (Component_Associations (N));
       while Present (Comp) loop
          Selector := Entity (First (Choices (Comp)));
+         pragma Assert (Present (Selector));
 
          --  C++ constructors
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 1d8d4fc30f81..9cf21953fea7 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -6235,6 +6235,19 @@ package body Sem_Util is
          --  Examine parent type
 
          if Etype (Typ) /= Typ then
+            --  Prevent infinite recursion, which can happen in illegal
+            --  programs. Silently return if illegal. For now, just deal
+            --  with the 2-type cycle case. Larger cycles will get
+            --  SIGSEGV at compile time from running out of stack.
+
+            if Etype (Etype (Typ)) = Typ then
+               if Total_Errors_Detected = 0 then
+                  raise Program_Error;
+               else
+                  return;
+               end if;
+            end if;
+
             Process_Type (Etype (Typ));
          end if;