diff mbox series

[COMMITTED,14/31] ada: Fix regression in Root_Type

Message ID 20250911091904.1505690-14-poulhies@adacore.com
State Committed
Commit 61645a4f0520a9847adccd37555e3390ef7a4ca6
Headers
Series [COMMITTED,01/31] ada: Disable new warning for composite equality ops that can raise Program_Error |

Commit Message

Marc Poulhiès Sept. 11, 2025, 9:18 a.m. UTC 
  From: Bob Duff <duff@adacore.com>

Previous change, "Make pp and friends more robust (base type only)"
introduced a bug in Root_Type. Etype (T) can, in fact, be Empty
(but only in case of errors.) This patch fixes it.

gcc/ada/ChangeLog:

	* einfo-utils.adb (Root_Type): Deal with missing Etype.
	(Root_Type_If_Set): Likewise.

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

---
 gcc/ada/einfo-utils.adb | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)
diff mbox series

Patch

diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
index d84e562853cc..450d4c36b211 100644
--- a/gcc/ada/einfo-utils.adb
+++ b/gcc/ada/einfo-utils.adb
@@ -2585,7 +2585,11 @@  package body Einfo.Utils is
             loop
                Etyp := Etype (T);
 
-               exit when T = Etyp
+               if No (Etyp) then
+                  Check_Error_Detected;
+               end if;
+
+               exit when No (Etyp) or else T = Etyp
                  or else
                    (Is_Private_Type (T) and then Etyp = Full_View (T))
                  or else
@@ -2609,6 +2613,10 @@  package body Einfo.Utils is
       end return;
    end Root_Type;
 
+   ----------------------
+   -- Root_Type_If_Set --
+   ----------------------
+
    function Root_Type_If_Set (Id : E) return Opt_N_Entity_Id is
       Etyp : Entity_Id;
 
@@ -2620,12 +2628,7 @@  package body Einfo.Utils is
             loop
                Etyp := Etype (T);
 
-               if No (Etyp) then
-                  T := Empty;
-                  exit;
-               end if;
-
-               exit when T = Etyp
+               exit when No (Etyp) or else T = Etyp
                  or else
                    (Is_Private_Type (T) and then Etyp = Full_View (T))
                  or else