From 97810ccb01b21dd8c5ed4e84d5aa2bc6c0dd8a45 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 13 May 2024 16:15:10 +0200 Subject: ada: Fix parts of classification of aspects Many aspects are (correctly) marked as GNAT-specific but nevertheless not listed in the Implementation_Defined_Aspect array, so this aligns the two sides and also removes Default_Initial_Condition and Object_Size from the list, since they are defined in Ada 2022. This also moves No_Controlled_Parts and No_Task_Parts to the subclass of boolean aspects, and completes the list of nonoverridable aspects defined in Ada 2022. gcc/ada/ * aspects.ads (Aspect_Id): Alphabetize, remove the GNAT tag from Default_Initial_Condition and Object_Size, move No_Controlled_Parts and No_Task_Parts to boolean subclass. (Nonoverridable_Aspect_Id): Add missing Ada 2022 aspects. (Implementation_Defined_Aspect): Add all missing aspects, remove Max_Entry_Queue_Length and Object_Size (Aspect_Argument): Remove specific entries for No_Controlled_Parts and No_Task_Parts, list boolean aspects last. (Is_Representation_Aspect ): Move boolean aspects last. (Aspect_Names): Alphabetize. * sem_ch13.adb (Analyze_Aspect_Disable_Controlled): Adjust. (Analyze_Aspect_Specifications): Move around processing for No_Controlled_Parts and No_Task_Parts. (Check_Aspect_At_Freeze_Point): Remove specific entries for No_Controlled_Parts and No_Task_Parts --- gcc/ada/aspects.ads | 94 +++++++++++++++++++++++++++++++++------------------- gcc/ada/sem_ch13.adb | 69 ++++++++++++++++++++++---------------- 2 files changed, 101 insertions(+), 62 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index d4aafb1a4f1..202d42193d1 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -64,10 +64,14 @@ with Types; use Types; package Aspects is - -- Type defining recognized aspects + -- Type enumerating the recognized aspects. The GNAT tag must be in keeping + -- with the Implementation_Defined_Aspect array below. type Aspect_Id is (No_Aspect, -- Dummy entry for no aspect + + -- The following aspects do not have a (static) boolean value + Aspect_Abstract_State, -- GNAT Aspect_Address, Aspect_Aggregate, @@ -81,7 +85,7 @@ package Aspects is Aspect_Convention, Aspect_CPU, Aspect_Default_Component_Value, - Aspect_Default_Initial_Condition, -- GNAT + Aspect_Default_Initial_Condition, Aspect_Default_Iterator, Aspect_Default_Storage_Pool, Aspect_Default_Value, @@ -104,8 +108,8 @@ package Aspects is Aspect_Integer_Literal, Aspect_Interrupt_Priority, Aspect_Invariant, -- GNAT - Aspect_Iterator_Element, Aspect_Iterable, -- GNAT + Aspect_Iterator_Element, Aspect_Link_Name, Aspect_Linker_Section, -- GNAT Aspect_Local_Restrictions, -- GNAT @@ -113,9 +117,7 @@ package Aspects is Aspect_Max_Entry_Queue_Depth, -- GNAT Aspect_Max_Entry_Queue_Length, Aspect_Max_Queue_Length, -- GNAT - Aspect_No_Controlled_Parts, - Aspect_No_Task_Parts, -- GNAT - Aspect_Object_Size, -- GNAT + Aspect_Object_Size, Aspect_Obsolescent, -- GNAT Aspect_Output, Aspect_Part_Of, -- GNAT @@ -186,10 +188,10 @@ package Aspects is Aspect_Atomic, Aspect_Atomic_Components, Aspect_Constant_After_Elaboration, -- GNAT - Aspect_Disable_Controlled, -- GNAT - Aspect_Discard_Names, Aspect_CUDA_Device, -- GNAT Aspect_CUDA_Global, -- GNAT + Aspect_Disable_Controlled, -- GNAT + Aspect_Discard_Names, Aspect_Effective_Reads, -- GNAT Aspect_Effective_Writes, -- GNAT Aspect_Exclusive_Functions, @@ -206,9 +208,11 @@ package Aspects is Aspect_Interrupt_Handler, Aspect_Lock_Free, -- GNAT Aspect_No_Caching, -- GNAT + Aspect_No_Controlled_Parts, Aspect_No_Inline, -- GNAT Aspect_No_Return, Aspect_No_Tagged_Streams, -- GNAT + Aspect_No_Task_Parts, -- GNAT Aspect_Pack, Aspect_Persistent_BSS, -- GNAT Aspect_Preelaborable_Initialization, @@ -242,12 +246,13 @@ package Aspects is | Aspect_Constant_Indexing | Aspect_Default_Iterator | Aspect_Implicit_Dereference + | Aspect_Integer_Literal | Aspect_Iterator_Element | Aspect_Max_Entry_Queue_Length | Aspect_No_Controlled_Parts + | Aspect_Real_Literal + | Aspect_String_Literal | Aspect_Variable_Indexing; - -- ??? No_Controlled_Parts not yet in Aspect_Id enumeration see RM - -- 13.1.1(18.7). -- The following array indicates aspects that accept 'Class @@ -275,9 +280,13 @@ package Aspects is Aspect_Async_Writers => True, Aspect_Constant_After_Elaboration => True, Aspect_Contract_Cases => True, + Aspect_CUDA_Device => True, + Aspect_CUDA_Global => True, Aspect_Depends => True, + Aspect_Designated_Storage_Model => True, Aspect_Dimension => True, Aspect_Dimension_System => True, + Aspect_Disable_Controlled => True, Aspect_Effective_Reads => True, Aspect_Effective_Writes => True, Aspect_Exceptional_Cases => True, @@ -287,16 +296,30 @@ package Aspects is Aspect_Ghost_Predicate => True, Aspect_Global => True, Aspect_GNAT_Annotate => True, + Aspect_Initial_Condition => True, + Aspect_Initializes => True, Aspect_Inline_Always => True, Aspect_Invariant => True, + Aspect_Iterable => True, + Aspect_Linker_Section => True, + Aspect_Local_Restrictions => True, Aspect_Lock_Free => True, Aspect_Max_Entry_Queue_Depth => True, - Aspect_Max_Entry_Queue_Length => True, Aspect_Max_Queue_Length => True, - Aspect_Object_Size => True, + Aspect_No_Caching => True, + Aspect_No_Elaboration_Code_All => True, + Aspect_No_Inline => True, + Aspect_No_Tagged_Streams => True, + Aspect_No_Task_Parts => True, + Aspect_Obsolescent => True, + Aspect_Part_Of => True, Aspect_Persistent_BSS => True, Aspect_Predicate => True, Aspect_Pure_Function => True, + Aspect_Refined_Depends => True, + Aspect_Refined_Global => True, + Aspect_Refined_Post => True, + Aspect_Refined_State => True, Aspect_Relaxed_Initialization => True, Aspect_Remote_Access_Type => True, Aspect_Scalar_Storage_Order => True, @@ -305,16 +328,21 @@ package Aspects is Aspect_Side_Effects => True, Aspect_Simple_Storage_Pool => True, Aspect_Simple_Storage_Pool_Type => True, + Aspect_SPARK_Mode => True, + Aspect_Storage_Model_Type => True, Aspect_Subprogram_Variant => True, Aspect_Suppress_Debug_Info => True, Aspect_Suppress_Initialization => True, Aspect_Thread_Local_Storage => True, Aspect_Test_Case => True, + Aspect_Unimplemented => True, Aspect_Universal_Aliasing => True, Aspect_Unmodified => True, Aspect_Unreferenced => True, Aspect_Unreferenced_Objects => True, + Aspect_User_Aspect => True, Aspect_Value_Size => True, + Aspect_Volatile_Full_Access => True, Aspect_Volatile_Function => True, Aspect_Warnings => True, others => False); @@ -329,8 +357,8 @@ package Aspects is (Aspect_Aggregate => True, Aspect_Constant_Indexing => True, Aspect_Default_Iterator => True, - Aspect_Iterator_Element => True, Aspect_Iterable => True, + Aspect_Iterator_Element => True, Aspect_Variable_Indexing => True, others => False); @@ -425,8 +453,6 @@ package Aspects is Aspect_Max_Entry_Queue_Depth => Expression, Aspect_Max_Entry_Queue_Length => Expression, Aspect_Max_Queue_Length => Expression, - Aspect_No_Controlled_Parts => Optional_Expression, - Aspect_No_Task_Parts => Optional_Expression, Aspect_Object_Size => Expression, Aspect_Obsolescent => Optional_Expression, Aspect_Output => Name, @@ -473,8 +499,8 @@ package Aspects is Aspect_Warnings => Name, Aspect_Write => Name, - Boolean_Aspects => Optional_Expression, - Library_Unit_Aspects => Optional_Expression); + Library_Unit_Aspects => Optional_Expression, + Boolean_Aspects => Optional_Expression); -- The following array indicates what aspects are representation aspects @@ -484,20 +510,14 @@ package Aspects is Aspect_Address => True, Aspect_Aggregate => False, Aspect_Alignment => True, - Aspect_Always_Terminates => False, Aspect_Annotate => False, - Aspect_Async_Readers => False, - Aspect_Async_Writers => False, Aspect_Attach_Handler => False, Aspect_Bit_Order => True, Aspect_Component_Size => True, - Aspect_Constant_After_Elaboration => False, Aspect_Constant_Indexing => False, Aspect_Contract_Cases => False, Aspect_Convention => True, Aspect_CPU => False, - Aspect_CUDA_Device => False, - Aspect_CUDA_Global => False, Aspect_Default_Component_Value => True, Aspect_Default_Initial_Condition => False, Aspect_Default_Iterator => False, @@ -509,14 +529,10 @@ package Aspects is Aspect_Dimension_System => False, Aspect_Dispatching_Domain => False, Aspect_Dynamic_Predicate => False, - Aspect_Effective_Reads => False, - Aspect_Effective_Writes => False, Aspect_Exceptional_Cases => False, Aspect_Exclusive_Functions => False, - Aspect_Extensions_Visible => False, Aspect_External_Name => False, Aspect_External_Tag => False, - Aspect_Ghost => False, Aspect_Ghost_Predicate => False, Aspect_Global => False, Aspect_GNAT_Annotate => False, @@ -536,9 +552,6 @@ package Aspects is Aspect_Max_Entry_Queue_Depth => False, Aspect_Max_Entry_Queue_Length => False, Aspect_Max_Queue_Length => False, - Aspect_No_Caching => False, - Aspect_No_Controlled_Parts => False, - Aspect_No_Task_Parts => False, Aspect_Object_Size => True, Aspect_Obsolescent => False, Aspect_Output => False, @@ -561,7 +574,6 @@ package Aspects is Aspect_Relaxed_Initialization => False, Aspect_Scalar_Storage_Order => True, Aspect_Secondary_Stack_Size => True, - Aspect_Side_Effects => False, Aspect_Simple_Storage_Pool => True, Aspect_Size => True, Aspect_Small => True, @@ -583,36 +595,49 @@ package Aspects is Aspect_User_Aspect => False, Aspect_Value_Size => True, Aspect_Variable_Indexing => False, - Aspect_Volatile_Function => False, Aspect_Warnings => False, Aspect_Write => False, Library_Unit_Aspects => False, + Aspect_Always_Terminates => False, Aspect_Asynchronous => True, + Aspect_Async_Readers => False, + Aspect_Async_Writers => False, Aspect_Atomic => True, Aspect_Atomic_Components => True, + Aspect_Constant_After_Elaboration => False, + Aspect_CUDA_Device => False, + Aspect_CUDA_Global => False, Aspect_Disable_Controlled => False, Aspect_Discard_Names => True, + Aspect_Effective_Reads => False, + Aspect_Effective_Writes => False, Aspect_Export => True, + Aspect_Extensions_Visible => False, Aspect_Favor_Top_Level => False, Aspect_Full_Access_Only => True, + Aspect_Ghost => False, + Aspect_Import => True, Aspect_Independent => True, Aspect_Independent_Components => True, - Aspect_Import => True, Aspect_Inline => False, Aspect_Inline_Always => False, Aspect_Interrupt_Handler => False, Aspect_Lock_Free => False, + Aspect_No_Caching => False, + Aspect_No_Controlled_Parts => False, Aspect_No_Inline => False, Aspect_No_Return => False, Aspect_No_Tagged_Streams => False, + Aspect_No_Task_Parts => False, Aspect_Pack => True, Aspect_Persistent_BSS => True, Aspect_Preelaborable_Initialization => False, Aspect_Pure_Function => False, Aspect_Remote_Access_Type => False, Aspect_Shared => True, + Aspect_Side_Effects => False, Aspect_Simple_Storage_Pool_Type => True, Aspect_Static => False, Aspect_Suppress_Debug_Info => False, @@ -626,6 +651,7 @@ package Aspects is Aspect_Volatile => True, Aspect_Volatile_Components => True, Aspect_Volatile_Full_Access => True, + Aspect_Volatile_Function => False, Aspect_Yield => False); ----------------------------------------- @@ -699,8 +725,8 @@ package Aspects is Aspect_Interrupt_Handler => Name_Interrupt_Handler, Aspect_Interrupt_Priority => Name_Interrupt_Priority, Aspect_Invariant => Name_Invariant, - Aspect_Iterator_Element => Name_Iterator_Element, Aspect_Iterable => Name_Iterable, + Aspect_Iterator_Element => Name_Iterator_Element, Aspect_Link_Name => Name_Link_Name, Aspect_Linker_Section => Name_Linker_Section, Aspect_Lock_Free => Name_Lock_Free, diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 2fbddf3f952..cd47f734462 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1869,6 +1869,8 @@ package body Sem_Ch13 is procedure Analyze_Aspect_Disable_Controlled is begin + Error_Msg_Name_1 := Nam; + -- The aspect applies only to controlled records if not (Ekind (E) = E_Record_Type @@ -3796,32 +3798,6 @@ package body Sem_Ch13 is Insert_Pragma (Aitem); goto Continue; - -- No_Controlled_Parts, No_Task_Parts - - when Aspect_No_Controlled_Parts | Aspect_No_Task_Parts => - - -- Check appropriate type argument - - if not Is_Type (E) then - Error_Msg_N - ("aspect % can only be applied to types", E); - end if; - - -- Disallow subtypes - - if Nkind (Declaration_Node (E)) = N_Subtype_Declaration then - Error_Msg_N - ("aspect % cannot be applied to subtypes", E); - end if; - - -- Resolve the expression to a boolean - - if Present (Expr) then - Check_Expr_Is_OK_Static_Expression (Expr, Any_Boolean); - end if; - - goto Continue; - -- Obsolescent when Aspect_Obsolescent => declare @@ -4503,6 +4479,45 @@ package body Sem_Ch13 is elsif A_Id = Aspect_Full_Access_Only then Error_Msg_Ada_2022_Feature ("aspect %", Loc); + -- No_Controlled_Parts, No_Task_Parts + + elsif A_Id in Aspect_No_Controlled_Parts + | Aspect_No_Task_Parts + then + Error_Msg_Name_1 := Nam; + + -- Disallow formal types + + if Nkind (Original_Node (N)) = N_Formal_Type_Declaration + then + Error_Msg_N + ("aspect % not allowed for formal type declaration", + Aspect); + + -- Disallow subtypes + + elsif Nkind (Original_Node (N)) = N_Subtype_Declaration + then + Error_Msg_N + ("aspect % not allowed for subtype declaration", + Aspect); + + -- Accept all other types + + elsif not Is_Type (E) then + Error_Msg_N + ("aspect % can only be specified for a type", + Aspect); + end if; + + -- Resolve the expression to a boolean + + if Present (Expr) then + Check_Expr_Is_OK_Static_Expression (Expr, Any_Boolean); + end if; + + goto Continue; + -- Ada 2022 (AI12-0075): static expression functions elsif A_Id = Aspect_Static then @@ -11539,8 +11554,6 @@ package body Sem_Ch13 is | Aspect_Max_Entry_Queue_Depth | Aspect_Max_Entry_Queue_Length | Aspect_Max_Queue_Length - | Aspect_No_Controlled_Parts - | Aspect_No_Task_Parts | Aspect_Obsolescent | Aspect_Part_Of | Aspect_Post -- cgit v1.2.3