diff mbox series

[COMMITTED,13/31] ada: Crash on b3a1004 with assertions enabled

Message ID 20250911091904.1505690-13-poulhies@adacore.com
State Committed
Commit ffcd00c6f1d98fb86a9e5a4c7e645c69e34194e4
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: Javier Miranda <miranda@adacore.com>

The compilation of files b3a10041.ads and b3a10042.adb crash when
the compiler is built with assertions enabled.

gcc/ada/ChangeLog:

	* freeze.adb (Freeze_Entity): Protect call to Associated_Storage_Pool
	since it cannot be used when the Etype is not set.
	* sem_ch3.adb (Access_Type_Declaration): Ditto.
	* sem_aux.adb (Is_Derived_Type): Protect call to Root_Type since it
	cannot be used when the Etype is not set.

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

---
 gcc/ada/freeze.adb  |  9 ++++++++-
 gcc/ada/sem_aux.adb |  1 +
 gcc/ada/sem_ch3.adb | 10 ++++++++--
 3 files changed, 17 insertions(+), 3 deletions(-)
diff mbox series

Patch

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 1bbc24f62fe2..31a583b769e8 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -7750,7 +7750,14 @@  package body Freeze is
 
             --  Check restriction for standard storage pool
 
-            if No (Associated_Storage_Pool (E)) then
+            --  Skip this check when Etype (T) is unknown, since attribute
+            --  Associated_Storage_Pool is only available in the root type
+            --  of E, and in such case it cannot not be computed (thus
+            --  causing spurious errors).
+
+            if Present (Etype (E))
+              and then No (Associated_Storage_Pool (E))
+            then
                Check_Restriction (No_Standard_Storage_Pools, E);
             end if;
 
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 0aa74e39050a..58a4beb221db 100644
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -959,6 +959,7 @@  package body Sem_Aux is
 
    begin
       if Is_Type (Ent)
+        and then Present (Etype (Ent))
         and then Base_Type (Ent) /= Root_Type (Ent)
         and then not Is_Class_Wide_Type (Ent)
 
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index b31587b4bcb1..3317fd209816 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1476,9 +1476,15 @@  package body Sem_Ch3 is
       --  This reset is performed in most cases except where the access type
       --  has been created for the purposes of allocating or deallocating a
       --  build-in-place object. Such access types have explicitly set pools
-      --  and finalization collections.
+      --  and finalization collections. It is also skipped when Etype (T) is
+      --  unknown, since attribute Associated_Storage_Pool is only available
+      --  in the root type of T, and in such case it cannot not be computed
+      --  (thus causing spurious errors). Etype (T) is unknown when errors
+      --  have been previously reported on T.
 
-      if No (Associated_Storage_Pool (T)) then
+      if Present (Etype (T))
+        and then No (Associated_Storage_Pool (T))
+      then
          Set_Finalization_Collection (T, Empty);
       end if;