diff mbox series

[COMMITTED] ada: prevent infinite recursion in Collect_Types_In_Hierarchy

Message ID 20230522084906.1725082-1-poulhies@adacore.com
State New
Headers show
Series [COMMITTED] ada: prevent infinite recursion in Collect_Types_In_Hierarchy | expand

Commit Message

Marc Poulhiès May 22, 2023, 8:49 a.m. UTC 
From: Bob Duff <duff@adacore.com>

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.

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

---
 gcc/ada/exp_aggr.adb |  1 +
 gcc/ada/sem_util.adb | 13 +++++++++++++
 2 files changed, 14 insertions(+)
diff mbox series

Patch

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index fe61e0ec90b..58831bd51ca 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 1d8d4fc30f8..9cf21953fea 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;