-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2019, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with Sinfo; use Sinfo;
with Tree_IO; use Tree_IO;
-with GNAT.HTable; use GNAT.HTable;
+with GNAT.HTable;
package body Aspects is
Aspect_Unchecked_Union => True,
Aspect_Variable_Indexing => True,
Aspect_Volatile => True,
+ Aspect_Volatile_Full_Access => True,
others => False);
-- The following array indicates type aspects that are inherited and apply
pragma Assert (Has_Aspects (N));
pragma Assert (Nkind (N) in N_Body_Stub
- or else Nkind_In (N, N_Package_Body,
+ or else Nkind_In (N, N_Entry_Body,
+ N_Package_Body,
N_Protected_Body,
N_Subprogram_Body,
N_Task_Body));
return True;
end Aspects_On_Body_Or_Stub_OK;
+ ----------------------
+ -- Exchange_Aspects --
+ ----------------------
+
+ procedure Exchange_Aspects (N1 : Node_Id; N2 : Node_Id) is
+ begin
+ pragma Assert
+ (Permits_Aspect_Specifications (N1)
+ and then Permits_Aspect_Specifications (N2));
+
+ -- Perform the exchange only when both nodes have lists to be swapped
+
+ if Has_Aspects (N1) and then Has_Aspects (N2) then
+ declare
+ L1 : constant List_Id := Aspect_Specifications (N1);
+ L2 : constant List_Id := Aspect_Specifications (N2);
+ begin
+ Set_Parent (L1, N2);
+ Set_Parent (L2, N1);
+ Aspect_Specifications_Hash_Table.Set (N1, L2);
+ Aspect_Specifications_Hash_Table.Set (N2, L1);
+ end;
+ end if;
+ end Exchange_Aspects;
+
-----------------
-- Find_Aspect --
-----------------
Owner := Root_Type (Owner);
end if;
- if Is_Private_Type (Owner) and then Present (Full_View (Owner)) then
+ if Is_Private_Type (Owner)
+ and then Present (Full_View (Owner))
+ and then not Operational_Aspect (A)
+ then
Owner := Full_View (Owner);
end if;
end if;
---------------------------
procedure Move_Or_Merge_Aspects (From : Node_Id; To : Node_Id) is
- begin
- if Has_Aspects (From) then
+ procedure Relocate_Aspect (Asp : Node_Id);
+ -- Move aspect specification Asp to the aspect specifications of node To
- -- Merge the aspects of From into To. Make sure that From has no
- -- aspects after the merge takes place.
+ ---------------------
+ -- Relocate_Aspect --
+ ---------------------
+ procedure Relocate_Aspect (Asp : Node_Id) is
+ Asps : List_Id;
+
+ begin
if Has_Aspects (To) then
- Append_List
- (List => Aspect_Specifications (From),
- To => Aspect_Specifications (To));
- Remove_Aspects (From);
+ Asps := Aspect_Specifications (To);
- -- Otherwise simply move the aspects
+ -- Create a new aspect specification list for node To
else
- Move_Aspects (From => From, To => To);
+ Asps := New_List;
+ Set_Aspect_Specifications (To, Asps);
+ Set_Has_Aspects (To);
+ end if;
+
+ -- Remove the aspect from its original owner and relocate it to node
+ -- To.
+
+ Remove (Asp);
+ Append (Asp, Asps);
+ end Relocate_Aspect;
+
+ -- Local variables
+
+ Asp : Node_Id;
+ Asp_Id : Aspect_Id;
+ Next_Asp : Node_Id;
+
+ -- Start of processing for Move_Or_Merge_Aspects
+
+ begin
+ if Has_Aspects (From) then
+ Asp := First (Aspect_Specifications (From));
+ while Present (Asp) loop
+
+ -- Store the next aspect now as a potential relocation will alter
+ -- the contents of the list.
+
+ Next_Asp := Next (Asp);
+
+ -- When moving or merging aspects from a subprogram body stub that
+ -- also acts as a spec, relocate only those aspects that may apply
+ -- to a body [stub]. Note that a precondition must also be moved
+ -- to the proper body as the pre/post machinery expects it to be
+ -- there.
+
+ if Nkind (From) = N_Subprogram_Body_Stub
+ and then No (Corresponding_Spec_Of_Stub (From))
+ then
+ Asp_Id := Get_Aspect_Id (Asp);
+
+ if Aspect_On_Body_Or_Stub_OK (Asp_Id)
+ or else Asp_Id = Aspect_Pre
+ or else Asp_Id = Aspect_Precondition
+ then
+ Relocate_Aspect (Asp);
+ end if;
+
+ -- When moving or merging aspects from a single concurrent type
+ -- declaration, relocate only those aspects that may apply to the
+ -- anonymous object created for the type.
+
+ -- Note: It is better to use Is_Single_Concurrent_Type_Declaration
+ -- here, but Aspects and Sem_Util have incompatible licenses.
+
+ elsif Nkind_In
+ (Original_Node (From), N_Single_Protected_Declaration,
+ N_Single_Task_Declaration)
+ then
+ Asp_Id := Get_Aspect_Id (Asp);
+
+ if Aspect_On_Anonymous_Object_OK (Asp_Id) then
+ Relocate_Aspect (Asp);
+ end if;
+
+ -- Default case - relocate the aspect to its new owner
+
+ else
+ Relocate_Aspect (Asp);
+ end if;
+
+ Asp := Next_Asp;
+ end loop;
+
+ -- The relocations may have left node From's aspect specifications
+ -- list empty. If this is the case, simply remove the aspects.
+
+ if Is_Empty_List (Aspect_Specifications (From)) then
+ Remove_Aspects (From);
end if;
end if;
end Move_Or_Merge_Aspects;
Has_Aspect_Specifications_Flag : constant array (Node_Kind) of Boolean :=
(N_Abstract_Subprogram_Declaration => True,
N_Component_Declaration => True,
+ N_Entry_Body => True,
N_Entry_Declaration => True,
N_Exception_Declaration => True,
N_Exception_Renaming_Declaration => True,
Canonical_Aspect : constant array (Aspect_Id) of Aspect_Id :=
(No_Aspect => No_Aspect,
Aspect_Abstract_State => Aspect_Abstract_State,
- Aspect_Ada_2005 => Aspect_Ada_2005,
- Aspect_Ada_2012 => Aspect_Ada_2005,
Aspect_Address => Aspect_Address,
Aspect_Alignment => Aspect_Alignment,
Aspect_All_Calls_Remote => Aspect_All_Calls_Remote,
+ Aspect_Annotate => Aspect_Annotate,
+ Aspect_Async_Readers => Aspect_Async_Readers,
+ Aspect_Async_Writers => Aspect_Async_Writers,
Aspect_Asynchronous => Aspect_Asynchronous,
Aspect_Atomic => Aspect_Atomic,
Aspect_Atomic_Components => Aspect_Atomic_Components,
Aspect_Attach_Handler => Aspect_Attach_Handler,
Aspect_Bit_Order => Aspect_Bit_Order,
- Aspect_Compiler_Unit => Aspect_Compiler_Unit,
Aspect_Component_Size => Aspect_Component_Size,
+ Aspect_Constant_After_Elaboration => Aspect_Constant_After_Elaboration,
Aspect_Constant_Indexing => Aspect_Constant_Indexing,
Aspect_Contract_Cases => Aspect_Contract_Cases,
Aspect_Convention => Aspect_Convention,
Aspect_CPU => Aspect_CPU,
Aspect_Default_Component_Value => Aspect_Default_Component_Value,
+ Aspect_Default_Initial_Condition => Aspect_Default_Initial_Condition,
Aspect_Default_Iterator => Aspect_Default_Iterator,
+ Aspect_Default_Storage_Pool => Aspect_Default_Storage_Pool,
Aspect_Default_Value => Aspect_Default_Value,
Aspect_Depends => Aspect_Depends,
Aspect_Dimension => Aspect_Dimension,
Aspect_Dimension_System => Aspect_Dimension_System,
+ Aspect_Disable_Controlled => Aspect_Disable_Controlled,
Aspect_Discard_Names => Aspect_Discard_Names,
Aspect_Dispatching_Domain => Aspect_Dispatching_Domain,
Aspect_Dynamic_Predicate => Aspect_Predicate,
+ Aspect_Effective_Reads => Aspect_Effective_Reads,
+ Aspect_Effective_Writes => Aspect_Effective_Writes,
Aspect_Elaborate_Body => Aspect_Elaborate_Body,
Aspect_Export => Aspect_Export,
+ Aspect_Extensions_Visible => Aspect_Extensions_Visible,
Aspect_External_Name => Aspect_External_Name,
Aspect_External_Tag => Aspect_External_Tag,
Aspect_Favor_Top_Level => Aspect_Favor_Top_Level,
+ Aspect_Ghost => Aspect_Ghost,
Aspect_Global => Aspect_Global,
Aspect_Implicit_Dereference => Aspect_Implicit_Dereference,
Aspect_Import => Aspect_Import,
Aspect_Interrupt_Handler => Aspect_Interrupt_Handler,
Aspect_Interrupt_Priority => Aspect_Priority,
Aspect_Invariant => Aspect_Invariant,
+ Aspect_Iterable => Aspect_Iterable,
Aspect_Iterator_Element => Aspect_Iterator_Element,
Aspect_Link_Name => Aspect_Link_Name,
+ Aspect_Linker_Section => Aspect_Linker_Section,
Aspect_Lock_Free => Aspect_Lock_Free,
Aspect_Machine_Radix => Aspect_Machine_Radix,
+ Aspect_Max_Entry_Queue_Depth => Aspect_Max_Entry_Queue_Depth,
+ Aspect_Max_Entry_Queue_Length => Aspect_Max_Entry_Queue_Length,
+ Aspect_Max_Queue_Length => Aspect_Max_Queue_Length,
+ Aspect_No_Caching => Aspect_No_Caching,
+ Aspect_No_Elaboration_Code_All => Aspect_No_Elaboration_Code_All,
+ Aspect_No_Inline => Aspect_No_Inline,
Aspect_No_Return => Aspect_No_Return,
+ Aspect_No_Tagged_Streams => Aspect_No_Tagged_Streams,
+ Aspect_Obsolescent => Aspect_Obsolescent,
Aspect_Object_Size => Aspect_Object_Size,
Aspect_Output => Aspect_Output,
Aspect_Pack => Aspect_Pack,
+ Aspect_Part_Of => Aspect_Part_Of,
Aspect_Persistent_BSS => Aspect_Persistent_BSS,
Aspect_Post => Aspect_Post,
Aspect_Postcondition => Aspect_Post,
Aspect_Pre => Aspect_Pre,
Aspect_Precondition => Aspect_Pre,
Aspect_Predicate => Aspect_Predicate,
+ Aspect_Predicate_Failure => Aspect_Predicate_Failure,
Aspect_Preelaborate => Aspect_Preelaborate,
- Aspect_Preelaborate_05 => Aspect_Preelaborate_05,
Aspect_Preelaborable_Initialization => Aspect_Preelaborable_Initialization,
Aspect_Priority => Aspect_Priority,
Aspect_Pure => Aspect_Pure,
- Aspect_Pure_05 => Aspect_Pure_05,
- Aspect_Pure_12 => Aspect_Pure_12,
Aspect_Pure_Function => Aspect_Pure_Function,
Aspect_Refined_Depends => Aspect_Refined_Depends,
Aspect_Refined_Global => Aspect_Refined_Global,
Aspect_Read => Aspect_Read,
Aspect_Relative_Deadline => Aspect_Relative_Deadline,
Aspect_Scalar_Storage_Order => Aspect_Scalar_Storage_Order,
+ Aspect_Secondary_Stack_Size => Aspect_Secondary_Stack_Size,
Aspect_Shared => Aspect_Atomic,
Aspect_Shared_Passive => Aspect_Shared_Passive,
Aspect_Simple_Storage_Pool => Aspect_Simple_Storage_Pool,
Aspect_Stream_Size => Aspect_Stream_Size,
Aspect_Suppress => Aspect_Suppress,
Aspect_Suppress_Debug_Info => Aspect_Suppress_Debug_Info,
+ Aspect_Suppress_Initialization => Aspect_Suppress_Initialization,
Aspect_Synchronization => Aspect_Synchronization,
Aspect_Test_Case => Aspect_Test_Case,
+ Aspect_Thread_Local_Storage => Aspect_Thread_Local_Storage,
Aspect_Type_Invariant => Aspect_Invariant,
Aspect_Unchecked_Union => Aspect_Unchecked_Union,
+ Aspect_Unimplemented => Aspect_Unimplemented,
Aspect_Universal_Aliasing => Aspect_Universal_Aliasing,
Aspect_Universal_Data => Aspect_Universal_Data,
Aspect_Unmodified => Aspect_Unmodified,
Aspect_Value_Size => Aspect_Value_Size,
Aspect_Volatile => Aspect_Volatile,
Aspect_Volatile_Components => Aspect_Volatile_Components,
+ Aspect_Volatile_Full_Access => Aspect_Volatile_Full_Access,
+ Aspect_Volatile_Function => Aspect_Volatile_Function,
Aspect_Warnings => Aspect_Warnings,
Aspect_Write => Aspect_Write);
projects / thirdparty / gcc.git / blobdiff