From 9a7049fd649430ab0d377546585a9907d62b2655 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 23 Apr 2013 11:42:45 +0200 Subject: [PATCH] [multiple changes] 2013-04-23 Ed Schonberg * sem_ch3.adb (Analyze_Object_Declarations): Undo previous patch. * exp_util.adb (Expand_Subtype_From_Expr): If the expression is a source entity and the declaration is for an aliased unconstrained array, create a new subtype so that the flag Is_Constr_Subt_For_UN_Aliased does not pollute other entities. 2013-04-23 Hristian Kirtchev * aspects.adb: Move tables Base_Aspect and Inherited_Aspect from the spec to the body. (Find_Aspect): Update the call to Get_Aspect_Id. (Get_Aspect_Id): New version that takes an aspect specification. * aspects.ads: Reorganize all aspect related tables. (Get_Aspect_Id): New version that takes an aspect specification. * par_sco.adb (Traverse_Aspects): Update the call to Get_Aspect_Id. * sem_ch12.adb (Analyze_Generic_Subprogram_Declaration): Update the call to Get_Aspect_Id. * sem_ch13.adb (Analyze_Aspect_At_Freeze_Point): Update the call to Get_Aspect_Id. (Analyze_Aspect_Specifications): Update the call to Get_Aspect_Id. Update the call to Impl_Defined_Aspect. From-SVN: r198179 --- gcc/ada/ChangeLog | 23 +++ gcc/ada/aspects.adb | 40 ++++- gcc/ada/aspects.ads | 445 ++++++++++++++++++++++++--------------------------- gcc/ada/exp_util.adb | 14 +- gcc/ada/par_sco.adb | 2 +- gcc/ada/sem_ch12.adb | 4 +- gcc/ada/sem_ch13.adb | 11 +- gcc/ada/sem_ch3.adb | 9 +- 8 files changed, 292 insertions(+), 256 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9cb2680..5bdc8f8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2013-04-23 Ed Schonberg + + * sem_ch3.adb (Analyze_Object_Declarations): Undo previous patch. + * exp_util.adb (Expand_Subtype_From_Expr): If the expression + is a source entity and the declaration is for an aliased + unconstrained array, create a new subtype so that the flag + Is_Constr_Subt_For_UN_Aliased does not pollute other entities. + +2013-04-23 Hristian Kirtchev + + * aspects.adb: Move tables Base_Aspect and Inherited_Aspect + from the spec to the body. + (Find_Aspect): Update the call to Get_Aspect_Id. + (Get_Aspect_Id): New version that takes an aspect specification. + * aspects.ads: Reorganize all aspect related tables. + (Get_Aspect_Id): New version that takes an aspect specification. + * par_sco.adb (Traverse_Aspects): Update the call to Get_Aspect_Id. + * sem_ch12.adb (Analyze_Generic_Subprogram_Declaration): Update + the call to Get_Aspect_Id. + * sem_ch13.adb (Analyze_Aspect_At_Freeze_Point): Update the + call to Get_Aspect_Id. (Analyze_Aspect_Specifications): Update + the call to Get_Aspect_Id. Update the call to Impl_Defined_Aspect. + 2013-04-23 Robert Dewar * sem_prag.adb (Fix_Error): Rewrite to do more accurate job diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index fc2b3ad..f63cd2b 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -39,6 +39,36 @@ with GNAT.HTable; use GNAT.HTable; package body Aspects is + -- The following array indicates aspects that a subtype inherits from its + -- base type. True means that the subtype inherits the aspect from its base + -- type. False means it is not inherited. + + Base_Aspect : constant array (Aspect_Id) of Boolean := + (Aspect_Atomic => True, + Aspect_Atomic_Components => True, + Aspect_Constant_Indexing => True, + Aspect_Default_Iterator => True, + Aspect_Discard_Names => True, + Aspect_Independent_Components => True, + Aspect_Iterator_Element => True, + Aspect_Type_Invariant => True, + Aspect_Unchecked_Union => True, + Aspect_Variable_Indexing => True, + Aspect_Volatile => True, + others => False); + + -- The following array indicates type aspects that are inherited and apply + -- to the class-wide type as well. + + Inherited_Aspect : constant array (Aspect_Id) of Boolean := + (Aspect_Constant_Indexing => True, + Aspect_Default_Iterator => True, + Aspect_Implicit_Dereference => True, + Aspect_Iterator_Element => True, + Aspect_Remote_Types => True, + Aspect_Variable_Indexing => True, + others => False); + procedure Set_Aspect_Specifications_No_Check (N : Node_Id; L : List_Id); -- Same as Set_Aspect_Specifications, but does not contain the assertion -- that checks that N does not already have aspect specifications. This @@ -140,7 +170,7 @@ package body Aspects is Item := First_Rep_Item (Owner); while Present (Item) loop if Nkind (Item) = N_Aspect_Specification - and then Get_Aspect_Id (Chars (Identifier (Item))) = A + and then Get_Aspect_Id (Item) = A then return Item; end if; @@ -163,7 +193,7 @@ package body Aspects is if Permits_Aspect_Specifications (Decl) then Spec := First (Aspect_Specifications (Decl)); while Present (Spec) loop - if Get_Aspect_Id (Chars (Identifier (Spec))) = A then + if Get_Aspect_Id (Spec) = A then return Spec; end if; @@ -208,6 +238,12 @@ package body Aspects is return Aspect_Id_Hash_Table.Get (Name); end Get_Aspect_Id; + function Get_Aspect_Id (Aspect : Node_Id) return Aspect_Id is + begin + pragma Assert (Nkind (Aspect) = N_Aspect_Specification); + return Aspect_Id_Hash_Table.Get (Chars (Identifier (Aspect))); + end Get_Aspect_Id; + ---------------- -- Has_Aspect -- ---------------- diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 690b7b1..ee8676a 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -196,89 +196,59 @@ package Aspects is -- The following array indicates aspects that accept 'Class Class_Aspect_OK : constant array (Aspect_Id) of Boolean := - (Aspect_Invariant => True, - Aspect_Pre => True, - Aspect_Predicate => True, - Aspect_Post => True, - Aspect_Type_Invariant => True, - others => False); - - -- The following array indicates aspects that a subtype inherits from - -- its base type. True means that the subtype inherits the aspect from - -- its base type. False means it is not inherited. - - Base_Aspect : constant array (Aspect_Id) of Boolean := - (Aspect_Atomic => True, - Aspect_Atomic_Components => True, - Aspect_Discard_Names => True, - Aspect_Independent_Components => True, - Aspect_Iterator_Element => True, - Aspect_Constant_Indexing => True, - Aspect_Default_Iterator => True, - Aspect_Type_Invariant => True, - Aspect_Unchecked_Union => True, - Aspect_Variable_Indexing => True, - Aspect_Volatile => True, - others => False); + (Aspect_Invariant => True, + Aspect_Pre => True, + Aspect_Predicate => True, + Aspect_Post => True, + Aspect_Type_Invariant => True, + others => False); -- The following array identifies all implementation defined aspects - Impl_Defined_Aspects : constant array (Aspect_Id) of Boolean := - (Aspect_Abstract_State => True, - Aspect_Ada_2005 => True, - Aspect_Ada_2012 => True, - Aspect_Compiler_Unit => True, - Aspect_Contract_Cases => True, - Aspect_Depends => True, - Aspect_Dimension => True, - Aspect_Dimension_System => True, - Aspect_Favor_Top_Level => True, - Aspect_Ghost => True, - Aspect_Global => True, - Aspect_Inline_Always => True, - Aspect_Invariant => True, - Aspect_Lock_Free => True, - Aspect_Object_Size => True, - Aspect_Persistent_BSS => True, - Aspect_Predicate => True, - Aspect_Preelaborate_05 => True, - Aspect_Pure_05 => True, - Aspect_Pure_12 => True, - Aspect_Pure_Function => True, - Aspect_Remote_Access_Type => True, - Aspect_Scalar_Storage_Order => True, - Aspect_Shared => True, - Aspect_Simple_Storage_Pool => True, - Aspect_Simple_Storage_Pool_Type => True, - Aspect_Suppress_Debug_Info => True, - Aspect_Test_Case => True, - Aspect_Universal_Aliasing => True, - Aspect_Universal_Data => True, - Aspect_Unmodified => True, - Aspect_Unreferenced => True, - Aspect_Unreferenced_Objects => True, - Aspect_Value_Size => True, - Aspect_Warnings => True, - others => False); + Implementation_Defined_Aspect : constant array (Aspect_Id) of Boolean := + (Aspect_Abstract_State => True, + Aspect_Ada_2005 => True, + Aspect_Ada_2012 => True, + Aspect_Compiler_Unit => True, + Aspect_Contract_Cases => True, + Aspect_Depends => True, + Aspect_Dimension => True, + Aspect_Dimension_System => True, + Aspect_Favor_Top_Level => True, + Aspect_Ghost => True, + Aspect_Global => True, + Aspect_Inline_Always => True, + Aspect_Invariant => True, + Aspect_Lock_Free => True, + Aspect_Object_Size => True, + Aspect_Persistent_BSS => True, + Aspect_Predicate => True, + Aspect_Preelaborate_05 => True, + Aspect_Pure_05 => True, + Aspect_Pure_12 => True, + Aspect_Pure_Function => True, + Aspect_Remote_Access_Type => True, + Aspect_Scalar_Storage_Order => True, + Aspect_Shared => True, + Aspect_Simple_Storage_Pool => True, + Aspect_Simple_Storage_Pool_Type => True, + Aspect_Suppress_Debug_Info => True, + Aspect_Test_Case => True, + Aspect_Universal_Aliasing => True, + Aspect_Universal_Data => True, + Aspect_Unmodified => True, + Aspect_Unreferenced => True, + Aspect_Unreferenced_Objects => True, + Aspect_Value_Size => True, + Aspect_Warnings => True, + others => False); -- The following array indicates aspects for which multiple occurrences of -- the same aspect attached to the same declaration are allowed. No_Duplicates_Allowed : constant array (Aspect_Id) of Boolean := - (Aspect_Test_Case => False, - others => True); - - -- The following array indicates type aspects that are inherited and apply - -- to the class-wide type as well. - - Inherited_Aspect : constant array (Aspect_Id) of Boolean := - (Aspect_Constant_Indexing => True, - Aspect_Default_Iterator => True, - Aspect_Implicit_Dereference => True, - Aspect_Iterator_Element => True, - Aspect_Remote_Types => True, - Aspect_Variable_Indexing => True, - others => False); + (Aspect_Test_Case => False, + others => True); -- The following subtype defines aspects corresponding to library unit -- pragmas, these can only validly appear as aspects for library units, @@ -311,65 +281,65 @@ package Aspects is -- The following array indicates what argument type is required Aspect_Argument : constant array (Aspect_Id) of Aspect_Expression := - (No_Aspect => Optional, - Aspect_Abstract_State => Expression, - Aspect_Address => Expression, - Aspect_Alignment => Expression, - Aspect_Attach_Handler => Expression, - Aspect_Bit_Order => Expression, - Aspect_Component_Size => Expression, - Aspect_Constant_Indexing => Name, - Aspect_Contract_Cases => Expression, - Aspect_Convention => Name, - Aspect_CPU => Expression, - Aspect_Default_Component_Value => Expression, - Aspect_Default_Iterator => Name, - Aspect_Default_Value => Expression, - Aspect_Depends => Expression, - Aspect_Dimension => Expression, - Aspect_Dimension_System => Expression, - Aspect_Dispatching_Domain => Expression, - Aspect_Dynamic_Predicate => Expression, - Aspect_External_Name => Expression, - Aspect_External_Tag => Expression, - Aspect_Global => Expression, - Aspect_Implicit_Dereference => Name, - Aspect_Input => Name, - Aspect_Interrupt_Priority => Expression, - Aspect_Invariant => Expression, - Aspect_Iterator_Element => Name, - Aspect_Link_Name => Expression, - Aspect_Machine_Radix => Expression, - Aspect_Object_Size => Expression, - Aspect_Output => Name, - Aspect_Post => Expression, - Aspect_Postcondition => Expression, - Aspect_Pre => Expression, - Aspect_Precondition => Expression, - Aspect_Predicate => Expression, - Aspect_Priority => Expression, - Aspect_Read => Name, - Aspect_Relative_Deadline => Expression, - Aspect_Scalar_Storage_Order => Expression, - Aspect_Simple_Storage_Pool => Name, - Aspect_Size => Expression, - Aspect_Small => Expression, - Aspect_Static_Predicate => Expression, - Aspect_Storage_Pool => Name, - Aspect_Storage_Size => Expression, - Aspect_Stream_Size => Expression, - Aspect_Suppress => Name, - Aspect_Synchronization => Name, - Aspect_Test_Case => Expression, - Aspect_Type_Invariant => Expression, - Aspect_Unsuppress => Name, - Aspect_Value_Size => Expression, - Aspect_Variable_Indexing => Name, - Aspect_Warnings => Name, - Aspect_Write => Name, - - Library_Unit_Aspects => Optional, - Boolean_Aspects => Optional); + (No_Aspect => Optional, + Aspect_Abstract_State => Expression, + Aspect_Address => Expression, + Aspect_Alignment => Expression, + Aspect_Attach_Handler => Expression, + Aspect_Bit_Order => Expression, + Aspect_Component_Size => Expression, + Aspect_Constant_Indexing => Name, + Aspect_Contract_Cases => Expression, + Aspect_Convention => Name, + Aspect_CPU => Expression, + Aspect_Default_Component_Value => Expression, + Aspect_Default_Iterator => Name, + Aspect_Default_Value => Expression, + Aspect_Depends => Expression, + Aspect_Dimension => Expression, + Aspect_Dimension_System => Expression, + Aspect_Dispatching_Domain => Expression, + Aspect_Dynamic_Predicate => Expression, + Aspect_External_Name => Expression, + Aspect_External_Tag => Expression, + Aspect_Global => Expression, + Aspect_Implicit_Dereference => Name, + Aspect_Input => Name, + Aspect_Interrupt_Priority => Expression, + Aspect_Invariant => Expression, + Aspect_Iterator_Element => Name, + Aspect_Link_Name => Expression, + Aspect_Machine_Radix => Expression, + Aspect_Object_Size => Expression, + Aspect_Output => Name, + Aspect_Post => Expression, + Aspect_Postcondition => Expression, + Aspect_Pre => Expression, + Aspect_Precondition => Expression, + Aspect_Predicate => Expression, + Aspect_Priority => Expression, + Aspect_Read => Name, + Aspect_Relative_Deadline => Expression, + Aspect_Scalar_Storage_Order => Expression, + Aspect_Simple_Storage_Pool => Name, + Aspect_Size => Expression, + Aspect_Small => Expression, + Aspect_Static_Predicate => Expression, + Aspect_Storage_Pool => Name, + Aspect_Storage_Size => Expression, + Aspect_Stream_Size => Expression, + Aspect_Suppress => Name, + Aspect_Synchronization => Name, + Aspect_Test_Case => Expression, + Aspect_Type_Invariant => Expression, + Aspect_Unsuppress => Name, + Aspect_Value_Size => Expression, + Aspect_Variable_Indexing => Name, + Aspect_Warnings => Name, + Aspect_Write => Name, + + Boolean_Aspects => Optional, + Library_Unit_Aspects => Optional); ----------------------------------------- -- Table Linking Names and Aspect_Id's -- @@ -377,113 +347,118 @@ package Aspects is -- Table linking aspect names and id's - Aspect_Names : constant array (Aspect_Id) of Name_Id := ( - No_Aspect => No_Name, - Aspect_Abstract_State => Name_Abstract_State, - Aspect_Ada_2005 => Name_Ada_2005, - Aspect_Ada_2012 => Name_Ada_2012, - Aspect_Address => Name_Address, - Aspect_Alignment => Name_Alignment, - Aspect_All_Calls_Remote => Name_All_Calls_Remote, - Aspect_Asynchronous => Name_Asynchronous, - Aspect_Atomic => Name_Atomic, - Aspect_Atomic_Components => Name_Atomic_Components, - Aspect_Attach_Handler => Name_Attach_Handler, - Aspect_Bit_Order => Name_Bit_Order, - Aspect_Compiler_Unit => Name_Compiler_Unit, - Aspect_Component_Size => Name_Component_Size, - Aspect_Constant_Indexing => Name_Constant_Indexing, - Aspect_Contract_Cases => Name_Contract_Cases, - Aspect_Convention => Name_Convention, - Aspect_CPU => Name_CPU, - Aspect_Default_Iterator => Name_Default_Iterator, - Aspect_Default_Value => Name_Default_Value, - Aspect_Default_Component_Value => Name_Default_Component_Value, - Aspect_Depends => Name_Depends, - Aspect_Dimension => Name_Dimension, - Aspect_Dimension_System => Name_Dimension_System, - Aspect_Discard_Names => Name_Discard_Names, - Aspect_Dispatching_Domain => Name_Dispatching_Domain, - Aspect_Dynamic_Predicate => Name_Dynamic_Predicate, - Aspect_Elaborate_Body => Name_Elaborate_Body, - Aspect_External_Name => Name_External_Name, - Aspect_External_Tag => Name_External_Tag, - Aspect_Export => Name_Export, - Aspect_Favor_Top_Level => Name_Favor_Top_Level, - Aspect_Ghost => Name_Ghost, - Aspect_Global => Name_Global, - Aspect_Implicit_Dereference => Name_Implicit_Dereference, - Aspect_Import => Name_Import, - Aspect_Independent => Name_Independent, - Aspect_Independent_Components => Name_Independent_Components, - Aspect_Inline => Name_Inline, - Aspect_Inline_Always => Name_Inline_Always, - Aspect_Input => Name_Input, - Aspect_Interrupt_Handler => Name_Interrupt_Handler, - Aspect_Interrupt_Priority => Name_Interrupt_Priority, - Aspect_Invariant => Name_Invariant, - Aspect_Iterator_Element => Name_Iterator_Element, - Aspect_Link_Name => Name_Link_Name, - Aspect_Lock_Free => Name_Lock_Free, - Aspect_Machine_Radix => Name_Machine_Radix, - Aspect_No_Return => Name_No_Return, - Aspect_Object_Size => Name_Object_Size, - Aspect_Output => Name_Output, - Aspect_Pack => Name_Pack, - Aspect_Persistent_BSS => Name_Persistent_BSS, - Aspect_Post => Name_Post, - Aspect_Postcondition => Name_Postcondition, - Aspect_Pre => Name_Pre, - Aspect_Precondition => Name_Precondition, - Aspect_Predicate => Name_Predicate, - Aspect_Preelaborable_Initialization => Name_Preelaborable_Initialization, - Aspect_Preelaborate => Name_Preelaborate, - Aspect_Preelaborate_05 => Name_Preelaborate_05, - Aspect_Priority => Name_Priority, - Aspect_Pure => Name_Pure, - Aspect_Pure_05 => Name_Pure_05, - Aspect_Pure_12 => Name_Pure_12, - Aspect_Pure_Function => Name_Pure_Function, - Aspect_Read => Name_Read, - Aspect_Relative_Deadline => Name_Relative_Deadline, - Aspect_Remote_Access_Type => Name_Remote_Access_Type, - Aspect_Remote_Call_Interface => Name_Remote_Call_Interface, - Aspect_Remote_Types => Name_Remote_Types, - Aspect_Scalar_Storage_Order => Name_Scalar_Storage_Order, - Aspect_Shared => Name_Shared, - Aspect_Shared_Passive => Name_Shared_Passive, - Aspect_Simple_Storage_Pool => Name_Simple_Storage_Pool, - Aspect_Simple_Storage_Pool_Type => Name_Simple_Storage_Pool_Type, - Aspect_Size => Name_Size, - Aspect_Small => Name_Small, - Aspect_Static_Predicate => Name_Static_Predicate, - Aspect_Storage_Pool => Name_Storage_Pool, - Aspect_Storage_Size => Name_Storage_Size, - Aspect_Stream_Size => Name_Stream_Size, - Aspect_Suppress => Name_Suppress, - Aspect_Suppress_Debug_Info => Name_Suppress_Debug_Info, - Aspect_Synchronization => Name_Synchronization, - Aspect_Test_Case => Name_Test_Case, - Aspect_Type_Invariant => Name_Type_Invariant, - Aspect_Unchecked_Union => Name_Unchecked_Union, - Aspect_Universal_Aliasing => Name_Universal_Aliasing, - Aspect_Universal_Data => Name_Universal_Data, - Aspect_Unmodified => Name_Unmodified, - Aspect_Unreferenced => Name_Unreferenced, - Aspect_Unreferenced_Objects => Name_Unreferenced_Objects, - Aspect_Unsuppress => Name_Unsuppress, - Aspect_Value_Size => Name_Value_Size, - Aspect_Variable_Indexing => Name_Variable_Indexing, - Aspect_Volatile => Name_Volatile, - Aspect_Volatile_Components => Name_Volatile_Components, - Aspect_Warnings => Name_Warnings, - Aspect_Write => Name_Write); + Aspect_Names : constant array (Aspect_Id) of Name_Id := + (No_Aspect => No_Name, + Aspect_Abstract_State => Name_Abstract_State, + Aspect_Ada_2005 => Name_Ada_2005, + Aspect_Ada_2012 => Name_Ada_2012, + Aspect_Address => Name_Address, + Aspect_Alignment => Name_Alignment, + Aspect_All_Calls_Remote => Name_All_Calls_Remote, + Aspect_Asynchronous => Name_Asynchronous, + Aspect_Atomic => Name_Atomic, + Aspect_Atomic_Components => Name_Atomic_Components, + Aspect_Attach_Handler => Name_Attach_Handler, + Aspect_Bit_Order => Name_Bit_Order, + Aspect_Compiler_Unit => Name_Compiler_Unit, + Aspect_Component_Size => Name_Component_Size, + Aspect_Constant_Indexing => Name_Constant_Indexing, + Aspect_Contract_Cases => Name_Contract_Cases, + Aspect_Convention => Name_Convention, + Aspect_CPU => Name_CPU, + Aspect_Default_Iterator => Name_Default_Iterator, + Aspect_Default_Value => Name_Default_Value, + Aspect_Default_Component_Value => Name_Default_Component_Value, + Aspect_Depends => Name_Depends, + Aspect_Dimension => Name_Dimension, + Aspect_Dimension_System => Name_Dimension_System, + Aspect_Discard_Names => Name_Discard_Names, + Aspect_Dispatching_Domain => Name_Dispatching_Domain, + Aspect_Dynamic_Predicate => Name_Dynamic_Predicate, + Aspect_Elaborate_Body => Name_Elaborate_Body, + Aspect_External_Name => Name_External_Name, + Aspect_External_Tag => Name_External_Tag, + Aspect_Export => Name_Export, + Aspect_Favor_Top_Level => Name_Favor_Top_Level, + Aspect_Ghost => Name_Ghost, + Aspect_Global => Name_Global, + Aspect_Implicit_Dereference => Name_Implicit_Dereference, + Aspect_Import => Name_Import, + Aspect_Independent => Name_Independent, + Aspect_Independent_Components => Name_Independent_Components, + Aspect_Inline => Name_Inline, + Aspect_Inline_Always => Name_Inline_Always, + Aspect_Input => Name_Input, + Aspect_Interrupt_Handler => Name_Interrupt_Handler, + Aspect_Interrupt_Priority => Name_Interrupt_Priority, + Aspect_Invariant => Name_Invariant, + Aspect_Iterator_Element => Name_Iterator_Element, + Aspect_Link_Name => Name_Link_Name, + Aspect_Lock_Free => Name_Lock_Free, + Aspect_Machine_Radix => Name_Machine_Radix, + Aspect_No_Return => Name_No_Return, + Aspect_Object_Size => Name_Object_Size, + Aspect_Output => Name_Output, + Aspect_Pack => Name_Pack, + Aspect_Persistent_BSS => Name_Persistent_BSS, + Aspect_Post => Name_Post, + Aspect_Postcondition => Name_Postcondition, + Aspect_Pre => Name_Pre, + Aspect_Precondition => Name_Precondition, + Aspect_Predicate => Name_Predicate, + Aspect_Preelaborable_Initialization => Name_Preelaborable_Initialization, + Aspect_Preelaborate => Name_Preelaborate, + Aspect_Preelaborate_05 => Name_Preelaborate_05, + Aspect_Priority => Name_Priority, + Aspect_Pure => Name_Pure, + Aspect_Pure_05 => Name_Pure_05, + Aspect_Pure_12 => Name_Pure_12, + Aspect_Pure_Function => Name_Pure_Function, + Aspect_Read => Name_Read, + Aspect_Relative_Deadline => Name_Relative_Deadline, + Aspect_Remote_Access_Type => Name_Remote_Access_Type, + Aspect_Remote_Call_Interface => Name_Remote_Call_Interface, + Aspect_Remote_Types => Name_Remote_Types, + Aspect_Scalar_Storage_Order => Name_Scalar_Storage_Order, + Aspect_Shared => Name_Shared, + Aspect_Shared_Passive => Name_Shared_Passive, + Aspect_Simple_Storage_Pool => Name_Simple_Storage_Pool, + Aspect_Simple_Storage_Pool_Type => Name_Simple_Storage_Pool_Type, + Aspect_Size => Name_Size, + Aspect_Small => Name_Small, + Aspect_Static_Predicate => Name_Static_Predicate, + Aspect_Storage_Pool => Name_Storage_Pool, + Aspect_Storage_Size => Name_Storage_Size, + Aspect_Stream_Size => Name_Stream_Size, + Aspect_Suppress => Name_Suppress, + Aspect_Suppress_Debug_Info => Name_Suppress_Debug_Info, + Aspect_Synchronization => Name_Synchronization, + Aspect_Test_Case => Name_Test_Case, + Aspect_Type_Invariant => Name_Type_Invariant, + Aspect_Unchecked_Union => Name_Unchecked_Union, + Aspect_Universal_Aliasing => Name_Universal_Aliasing, + Aspect_Universal_Data => Name_Universal_Data, + Aspect_Unmodified => Name_Unmodified, + Aspect_Unreferenced => Name_Unreferenced, + Aspect_Unreferenced_Objects => Name_Unreferenced_Objects, + Aspect_Unsuppress => Name_Unsuppress, + Aspect_Value_Size => Name_Value_Size, + Aspect_Variable_Indexing => Name_Variable_Indexing, + Aspect_Volatile => Name_Volatile, + Aspect_Volatile_Components => Name_Volatile_Components, + Aspect_Warnings => Name_Warnings, + Aspect_Write => Name_Write); function Get_Aspect_Id (Name : Name_Id) return Aspect_Id; pragma Inline (Get_Aspect_Id); -- Given a name Nam, returns the corresponding aspect id value. If the name -- does not match any aspect, then No_Aspect is returned as the result. + function Get_Aspect_Id (Aspect : Node_Id) return Aspect_Id; + pragma Inline (Get_Aspect_Id); + -- Given an aspect specification, return the corresponding aspect_id value. + -- If the name does not match any aspect, return No_Aspect. + --------------------------------------------------- -- Handling of Aspect Specifications in the Tree -- --------------------------------------------------- diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index aa40b3d..778f159 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -2040,8 +2040,20 @@ package body Exp_Util is Make_Literal_Range (Loc, Literal_Typ => Exp_Typ))))); + -- If the type of the expression is an internally generated type it + -- may not be necessary to create a new subtype. However there are + -- two exceptions : references to the current instances, and aliased + -- array object declarations, for which the back-end needs to create + -- a template. + elsif Is_Constrained (Exp_Typ) and then not Is_Class_Wide_Type (Unc_Type) + and then + (Nkind (N) /= N_Object_Declaration + or else not Is_Entity_Name (Expression (N)) + or else not Comes_From_Source (Entity (Expression (N))) + or else not Is_Array_Type (Exp_Typ) + or else not Aliased_Present (N)) then if Is_Itype (Exp_Typ) then @@ -2066,7 +2078,7 @@ package body Exp_Util is end if; end; - -- No need to generate a new one (new what???) + -- No need to generate a new subtype else T := Exp_Typ; diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index c7aa5c1..29c2daa 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -1454,7 +1454,7 @@ package body Par_SCO is C1 := ASCII.NUL; - case Get_Aspect_Id (Chars (Identifier (AN))) is + case Get_Aspect_Id (AN) is -- Aspects rewritten into pragmas controlled by a Check_Policy: -- Current_Pragma_Sloc must be set to the sloc of the aspect diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 1fe5277..db30726 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3244,9 +3244,7 @@ package body Sem_Ch12 is begin Aspect := First (Aspect_Specifications (N)); while Present (Aspect) loop - if Get_Aspect_Id (Chars (Identifier (Aspect))) - /= Aspect_Warnings - then + if Get_Aspect_Id (Aspect) /= Aspect_Warnings then Analyze (Expression (Aspect)); end if; Next (Aspect); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index e100756..b144411 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -878,7 +878,7 @@ package body Sem_Ch13 is and then Entity (ASN) = E and then Is_Delayed_Aspect (ASN) then - A_Id := Get_Aspect_Id (Chars (Identifier (ASN))); + A_Id := Get_Aspect_Id (ASN); case A_Id is @@ -1081,7 +1081,7 @@ package body Sem_Ch13 is -- Check restriction No_Implementation_Aspect_Specifications - if Impl_Defined_Aspects (A_Id) then + if Implementation_Defined_Aspect (A_Id) then Check_Restriction (No_Implementation_Aspect_Specifications, Aspect); end if; @@ -1103,9 +1103,8 @@ package body Sem_Ch13 is if No_Duplicates_Allowed (A_Id) then Anod := First (L); while Anod /= Aspect loop - if Same_Aspect - (A_Id, Get_Aspect_Id (Chars (Identifier (Anod)))) - and then Comes_From_Source (Aspect) + if Comes_From_Source (Aspect) + and then Same_Aspect (A_Id, Get_Aspect_Id (Anod)) then Error_Msg_Name_1 := Nam; Error_Msg_Sloc := Sloc (Anod); @@ -1131,7 +1130,7 @@ package body Sem_Ch13 is -- Check some general restrictions on language defined aspects - if not Impl_Defined_Aspects (A_Id) then + if not Implementation_Defined_Aspect (A_Id) then Error_Msg_Name_1 := Nam; -- Not allowed for renaming declarations diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 55fce93..9a687db 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3404,14 +3404,7 @@ package body Sem_Ch3 is Set_Is_Constr_Subt_For_U_Nominal (Act_T); - -- If the expression is a source entity its type is defined - -- elsewhere. Otherwise it is a just-created subtype, and the - -- back-end may need to create a template for it. - - if Aliased_Present (N) - and then (not Is_Entity_Name (E) - or else not Comes_From_Source (E)) - then + if Aliased_Present (N) then Set_Is_Constr_Subt_For_UN_Aliased (Act_T); end if; -- 2.7.4