From e7148bc74f3bc306d28ce0ffee47f0876af99cc8 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Sat, 21 Mar 2020 12:34:20 -0400 Subject: [PATCH] [Ada] ACATS 4.2Q - BDD2007 2020-06-12 Arnaud Charlet gcc/ada/ * aspects.ads (Is_Representation_Aspect): New array. * sem_ch13.adb (Analyze_Aspect_Specifications): Check 13.1(9.2/5) for representation aspects. gcc/testsuite/ * gnat.dg/rep_clause8.adb: Update error location. --- gcc/ada/aspects.ads | 128 ++++++++++++++++++++++++++++++++++ gcc/ada/sem_ch13.adb | 11 +++ gcc/testsuite/gnat.dg/rep_clause8.adb | 4 +- 3 files changed, 141 insertions(+), 2 deletions(-) diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 73d12f30..82bf5ca 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -425,6 +425,134 @@ package Aspects is Boolean_Aspects => Optional_Expression, Library_Unit_Aspects => Optional_Expression); + -- The following array indicates what aspects are representation aspects + + Is_Representation_Aspect : constant array (Aspect_Id) of Boolean := + (No_Aspect => False, + Aspect_Abstract_State => False, + Aspect_Address => True, + Aspect_Alignment => True, + 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_Default_Component_Value => False, + Aspect_Default_Initial_Condition => False, + Aspect_Default_Iterator => False, + Aspect_Default_Storage_Pool => True, + Aspect_Default_Value => False, + Aspect_Depends => False, + Aspect_Dimension => False, + Aspect_Dimension_System => False, + Aspect_Dispatching_Domain => False, + Aspect_Dynamic_Predicate => False, + Aspect_Effective_Reads => False, + Aspect_Effective_Writes => False, + Aspect_Extensions_Visible => False, + Aspect_External_Name => False, + Aspect_External_Tag => False, + Aspect_Ghost => False, + Aspect_Global => False, + Aspect_Implicit_Dereference => False, + Aspect_Initial_Condition => False, + Aspect_Initializes => False, + Aspect_Input => False, + Aspect_Interrupt_Priority => False, + Aspect_Invariant => False, + Aspect_Iterable => False, + Aspect_Iterator_Element => False, + Aspect_Link_Name => True, + Aspect_Linker_Section => True, + Aspect_Machine_Radix => True, + Aspect_Max_Entry_Queue_Depth => False, + Aspect_Max_Entry_Queue_Length => False, + Aspect_Max_Queue_Length => False, + Aspect_No_Caching => False, + Aspect_Object_Size => True, + Aspect_Obsolescent => False, + Aspect_Output => False, + Aspect_Part_Of => False, + Aspect_Post => False, + Aspect_Postcondition => False, + Aspect_Pre => False, + Aspect_Precondition => False, + Aspect_Predicate => False, + Aspect_Predicate_Failure => False, + Aspect_Priority => False, + Aspect_Put_Image => False, + Aspect_Read => False, + Aspect_Refined_Depends => False, + Aspect_Refined_Global => False, + Aspect_Refined_Post => False, + Aspect_Refined_State => False, + Aspect_Relative_Deadline => False, + Aspect_Scalar_Storage_Order => True, + Aspect_Secondary_Stack_Size => True, + Aspect_Simple_Storage_Pool => True, + Aspect_Size => True, + Aspect_Small => True, + Aspect_SPARK_Mode => False, + Aspect_Static_Predicate => False, + Aspect_Storage_Pool => True, + Aspect_Storage_Size => True, + Aspect_Stream_Size => True, + Aspect_Suppress => False, + Aspect_Synchronization => False, + Aspect_Test_Case => False, + Aspect_Type_Invariant => False, + Aspect_Unimplemented => False, + Aspect_Unsuppress => False, + Aspect_Value_Size => True, + Aspect_Variable_Indexing => False, + Aspect_Volatile_Function => False, + Aspect_Warnings => False, + Aspect_Write => False, + + Library_Unit_Aspects => False, + + Aspect_Asynchronous => True, + Aspect_Atomic => True, + Aspect_Atomic_Components => True, + Aspect_Disable_Controlled => False, + Aspect_Discard_Names => True, + Aspect_Export => True, + Aspect_Favor_Top_Level => False, + 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_Inline => False, + Aspect_No_Return => False, + Aspect_No_Tagged_Streams => 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_Simple_Storage_Pool_Type => True, + Aspect_Suppress_Debug_Info => False, + Aspect_Suppress_Initialization => False, + Aspect_Thread_Local_Storage => True, + Aspect_Unchecked_Union => True, + Aspect_Universal_Aliasing => False, + Aspect_Unmodified => False, + Aspect_Unreferenced => False, + Aspect_Unreferenced_Objects => False, + Aspect_Volatile => True, + Aspect_Volatile_Components => True, + Aspect_Volatile_Full_Access => True); + ----------------------------------------- -- Table Linking Names and Aspect_Id's -- ----------------------------------------- diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 61695fc..0f23cbb 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2270,6 +2270,17 @@ package body Sem_Ch13 is end if; end case; + -- Check 13.1(9.2/5): A representation aspect of a subtype or type + -- shall not be specified (whether by a representation item or an + -- aspect_specification) before the type is completely defined + -- (see 3.11.1). + + if Is_Representation_Aspect (A_Id) + and then Rep_Item_Too_Early (E, N) + then + goto Continue; + end if; + -- Processing based on specific aspect case A_Id is diff --git a/gcc/testsuite/gnat.dg/rep_clause8.adb b/gcc/testsuite/gnat.dg/rep_clause8.adb index 11d1266..f886e37 100644 --- a/gcc/testsuite/gnat.dg/rep_clause8.adb +++ b/gcc/testsuite/gnat.dg/rep_clause8.adb @@ -9,8 +9,8 @@ procedure Rep_Clause8 is generic type Formal_Root is new Root with private; package Gen_Derived is - type Deriv is new Formal_Root with null record - with Size => 300; -- { dg-error "representation item not allowed for generic type" } + type Deriv is new Formal_Root with null record -- { dg-error "representation item not allowed for generic type" } + with Size => 300; end Gen_Derived; package Inst_Derived is new Gen_Derived (Root); -- 2.7.4