From: Eric Botcazou <ebotca...@adacore.com>
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
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/aspects.ads | 94 ++++++++++++++++++++++++++++----------------
gcc/ada/sem_ch13.adb | 69 +++++++++++++++++++-------------
2 files changed, 101 insertions(+), 62 deletions(-)
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
--
2.45.1
