[Ada] Assertion errors on concurrent types with -gnatc and extensions enabled
gcc/ada/ * einfo-utils.adb (Primitive_Operations): Default to returning Direct_Primitive_Operations in the case of concurrent types (when Corresponding_Record_Type not present). * sem_ch9.adb (Analyze_Protected_Type_Declaration): Initialize Direct_Primitive_Operations to an empty element list. (Analyze_Task_Type_Declaration): Initialize Direct_Primitive_Operations to an empty element list.
This commit is contained in:
parent
cce46226b0
commit
2c03e97c5a
@ -2493,15 +2493,15 @@ package body Einfo.Utils is
|
|||||||
return Direct_Primitive_Operations
|
return Direct_Primitive_Operations
|
||||||
(Corresponding_Record_Type (Id));
|
(Corresponding_Record_Type (Id));
|
||||||
|
|
||||||
-- If expansion is disabled the corresponding record type is absent,
|
-- When expansion is disabled, the corresponding record type is
|
||||||
-- but if the type has ancestors it may have primitive operations.
|
-- absent, but if this is a tagged type with ancestors, or if the
|
||||||
|
-- extension of prefixed calls for untagged types is enabled, then
|
||||||
elsif Is_Tagged_Type (Id) then
|
-- it may have associated primitive operations.
|
||||||
return Direct_Primitive_Operations (Id);
|
|
||||||
|
|
||||||
else
|
else
|
||||||
return No_Elist;
|
return Direct_Primitive_Operations (Id);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
else
|
else
|
||||||
return Direct_Primitive_Operations (Id);
|
return Direct_Primitive_Operations (Id);
|
||||||
end if;
|
end if;
|
||||||
|
@ -2031,6 +2031,12 @@ package body Sem_Ch9 is
|
|||||||
Set_Has_Delayed_Freeze (T);
|
Set_Has_Delayed_Freeze (T);
|
||||||
Set_Stored_Constraint (T, No_Elist);
|
Set_Stored_Constraint (T, No_Elist);
|
||||||
|
|
||||||
|
-- Initialize type's primitive operations list, for possible use when
|
||||||
|
-- the extension of prefixed call notation for untagged types is enabled
|
||||||
|
-- (such as by use of -gnatX).
|
||||||
|
|
||||||
|
Set_Direct_Primitive_Operations (T, New_Elmt_List);
|
||||||
|
|
||||||
-- Mark this type as a protected type for the sake of restrictions,
|
-- Mark this type as a protected type for the sake of restrictions,
|
||||||
-- unless the protected type is declared in a private part of a package
|
-- unless the protected type is declared in a private part of a package
|
||||||
-- of the runtime. With this exception, the Suspension_Object from
|
-- of the runtime. With this exception, the Suspension_Object from
|
||||||
@ -3152,6 +3158,12 @@ package body Sem_Ch9 is
|
|||||||
Set_Has_Delayed_Freeze (T, True);
|
Set_Has_Delayed_Freeze (T, True);
|
||||||
Set_Stored_Constraint (T, No_Elist);
|
Set_Stored_Constraint (T, No_Elist);
|
||||||
|
|
||||||
|
-- Initialize type's primitive operations list, for possible use when
|
||||||
|
-- the extension of prefixed call notation for untagged types is enabled
|
||||||
|
-- (such as by use of -gnatX).
|
||||||
|
|
||||||
|
Set_Direct_Primitive_Operations (T, New_Elmt_List);
|
||||||
|
|
||||||
-- Set the SPARK_Mode from the current context (may be overwritten later
|
-- Set the SPARK_Mode from the current context (may be overwritten later
|
||||||
-- with an explicit pragma).
|
-- with an explicit pragma).
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user