From: Javier Miranda <mira...@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 --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;
--
2.43.0
