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 1bbc24f62fe24347c1bd331d5204e46d89c989b4..31a583b769e872b94c43bbbe756a5b7f85d25ac5 100644 (file)
--- 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 0aa74e39050ab1ea2843c7d0c3ff088ba7d7ee89..58a4beb221db830e397ee8d5bfa3acab10d86acb 100644 (file)
--- 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 b31587b4bcb1f9352069082cb4c6edf79a6e7c11..3317fd2098168871ba43ca9770c2a2a6fe53de06 100644 (file)
--- 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;