Routines Is_Access_Object_Type and Is_Access_Subprogram_Type were
arbitrarily categorizing E_Access_Subtype as an access-to-object, even
though it could represent an access-to-subprogram.
Now those routines examine not just the Ekind, but also the
Designated_Type of an access (sub)type, which is more reliable.
Only the handling of Can_Use_Internal_Rep and Convention flags need to
be adjusted, because they are set before the Designated_Type. However,
those flags are only set at base type anyway, so there is no problem
with E_Access_Subtype being wrongly recognized and we can safely rely on
the Ekind to detect access-to-subprograms.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* einfo-utils.adb (Is_Access_Object_Type): Use
Directly_Designated_Type.
(Is_Access_Subprogram_Type): Use Directly_Designated_Type.
(Set_Convention): Use plain Ekind.
* gen_il-gen-gen_entities.adb (Type_Kind): Use plain Ekind.
* sem_ch3.adb (Access_Type_Declaration): When seeing an illegal
completion with an access type don't attempt to decorate the
completion entity; previously the entity had its Ekind set to
E_General_Access_Type or E_Access_Type, but its Designated_Type
was empty, which caused a crash in freezing. (Actually, the
error recovery in the surrounding context is still incomplete,
e.g. we will crash when the illegal completion is an access to
an unknown identifier).diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
--- a/gcc/ada/einfo-utils.adb
+++ b/gcc/ada/einfo-utils.adb
@@ -101,7 +101,8 @@ package body Einfo.Utils is
function Is_Access_Object_Type (Id : E) return B is
begin
- return Is_Access_Type (Id) and then not Is_Access_Subprogram_Type (Id);
+ return Is_Access_Type (Id)
+ and then Ekind (Directly_Designated_Type (Id)) /= E_Subprogram_Type;
end Is_Access_Object_Type;
function Is_Access_Type (Id : E) return B is
@@ -116,7 +117,8 @@ package body Einfo.Utils is
function Is_Access_Subprogram_Type (Id : E) return B is
begin
- return Ekind (Id) in Access_Subprogram_Kind;
+ return Is_Access_Type (Id)
+ and then Ekind (Directly_Designated_Type (Id)) = E_Subprogram_Type;
end Is_Access_Subprogram_Type;
function Is_Aggregate_Type (Id : E) return B is
@@ -2672,8 +2674,7 @@ package body Einfo.Utils is
begin
Set_Basic_Convention (E, Val);
- if Is_Type (E)
- and then Is_Access_Subprogram_Type (Base_Type (E))
+ if Ekind (E) in Access_Subprogram_Kind
and then Has_Foreign_Convention (E)
then
Set_Can_Use_Internal_Rep (E, False);
diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb
--- a/gcc/ada/gen_il-gen-gen_entities.adb
+++ b/gcc/ada/gen_il-gen-gen_entities.adb
@@ -480,7 +480,7 @@ begin -- Gen_IL.Gen.Gen_Entities
(Sm (Alignment, Uint),
Sm (Associated_Node_For_Itype, Node_Id),
Sm (Can_Use_Internal_Rep, Flag, Base_Type_Only,
- Pre => "Is_Access_Subprogram_Type (Base_Type (N))"),
+ Pre => "Ekind (Base_Type (N)) in Access_Subprogram_Kind"),
Sm (Class_Wide_Type, Node_Id),
Sm (Contract, Node_Id),
Sm (Current_Use_Clause, Node_Id),
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1354,6 +1354,7 @@ package body Sem_Ch3 is
else
pragma Assert (Error_Posted (T));
+ return;
end if;
-- If the designated type is a limited view, we cannot tell if
@@ -6725,7 +6726,9 @@ package body Sem_Ch3 is
Has_Private_Component (Derived_Type));
Conditional_Delay (Derived_Type, Subt);
- if Is_Access_Subprogram_Type (Derived_Type) then
+ if Is_Access_Subprogram_Type (Derived_Type)
+ and then Is_Base_Type (Derived_Type)
+ then
Set_Can_Use_Internal_Rep
(Derived_Type, Can_Use_Internal_Rep (Parent_Type));
end if;
