From 2c03e97c5a50acc10fcb3545385fac4c1a9fa543 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Fri, 21 May 2021 13:59:30 -0400 Subject: [PATCH] [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. --- gcc/ada/einfo-utils.adb | 12 ++++++------ gcc/ada/sem_ch9.adb | 12 ++++++++++++ 2 files changed, 18 insertions(+), 6 deletions(-) diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb index 22143d62aaa..b2d8a845022 100644 --- a/gcc/ada/einfo-utils.adb +++ b/gcc/ada/einfo-utils.adb @@ -2493,15 +2493,15 @@ package body Einfo.Utils is return Direct_Primitive_Operations (Corresponding_Record_Type (Id)); - -- If expansion is disabled the corresponding record type is absent, - -- but if the type has ancestors it may have primitive operations. - - elsif Is_Tagged_Type (Id) then - return Direct_Primitive_Operations (Id); + -- When expansion is disabled, the corresponding record type is + -- absent, but if this is a tagged type with ancestors, or if the + -- extension of prefixed calls for untagged types is enabled, then + -- it may have associated primitive operations. else - return No_Elist; + return Direct_Primitive_Operations (Id); end if; + else return Direct_Primitive_Operations (Id); end if; diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 969eff56e73..65f48a71b08 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -2031,6 +2031,12 @@ package body Sem_Ch9 is Set_Has_Delayed_Freeze (T); 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, -- unless the protected type is declared in a private part of a package -- 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_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 -- with an explicit pragma).