From: Javier Miranda <miranda@adacore.com>
Date: Sun, 17 Aug 2025 09:45:31 +0000 (+0000)
Subject: ada: Crash on b3a1004 with assertions enabled
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=ffcd00c6f1d98fb86a9e5a4c7e645c69e34194e4;p=thirdparty%2Fgcc.git

ada: Crash on b3a1004 with assertions enabled

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.
---

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 1bbc24f62fe..31a583b769e 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 0aa74e39050..58a4beb221d 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 b31587b4bcb..3317fd20981 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.
-
-      if No (Associated_Storage_Pool (T)) then
+      --  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 Present (Etype (T))
+        and then No (Associated_Storage_Pool (T))
+      then
          Set_Finalization_Collection (T, Empty);
       end if;