[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:
parent
104f58db5f
commit
a4613d9ada
3 changed files with 10 additions and 6 deletions
|
@ -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);
|
||||
|
|
|
@ -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),
|
||||
|
|
|
@ -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;
|
||||
|
|
Loading…
Add table
Reference in a new issue