[Ada] Robust detection of access-to-subprogram and access-to-object types

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).
This commit is contained in:
Piotr Trojanek 2021-02-23 23:37:50 +01:00 committed by Pierre-Marie de Rodat
parent 104f58db5f
commit a4613d9ada
3 changed files with 10 additions and 6 deletions

View file

@ -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);

View file

@ -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),

View file

@ -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;