[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:
Gary Dismukes 2021-05-21 13:59:30 -04:00 committed by Pierre-Marie de Rodat
parent cce46226b0
commit 2c03e97c5a
2 changed files with 18 additions and 6 deletions

View File

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

View File

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