]> git.ipfire.org Git - thirdparty/gcc.git/blobdiff - gcc/ada/aspects.adb
[Ada] Minor reformattings
[thirdparty/gcc.git] / gcc / ada / aspects.adb
index 88bd789b7928a86fc7fd4c1c5b7ac0515f5cff1a..3b8b7c4ec99c229108469807e6df11b18a1e6c97 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2010-2014, 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- --
@@ -35,7 +35,7 @@ with Nlists;   use Nlists;
 with Sinfo;    use Sinfo;
 with Tree_IO;  use Tree_IO;
 
-with GNAT.HTable;           use GNAT.HTable;
+with GNAT.HTable;
 
 package body Aspects is
 
@@ -55,6 +55,7 @@ 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
@@ -153,7 +154,8 @@ package body Aspects is
 
       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));
@@ -223,7 +225,10 @@ package body Aspects is
             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;
@@ -336,8 +341,7 @@ package body Aspects is
 
    procedure Move_Or_Merge_Aspects (From : Node_Id; To : Node_Id) is
       procedure Relocate_Aspect (Asp : Node_Id);
-      --  Asp denotes an aspect specification of node From. Relocate the Asp to
-      --  the aspect specifications of node To (if any).
+      --  Move aspect specification Asp to the aspect specifications of node To
 
       ---------------------
       -- Relocate_Aspect --
@@ -358,8 +362,8 @@ package body Aspects is
             Set_Has_Aspects (To);
          end if;
 
-         --  Remove the aspect from node From's aspect specifications and
-         --  append it to node To.
+         --  Remove the aspect from its original owner and relocate it to node
+         --  To.
 
          Remove (Asp);
          Append (Asp, Asps);
@@ -401,6 +405,23 @@ package body Aspects is
                   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
@@ -426,6 +447,7 @@ package body Aspects is
    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,
@@ -504,16 +526,20 @@ package body Aspects is
     Aspect_Attach_Handler               => Aspect_Attach_Handler,
     Aspect_Bit_Order                    => Aspect_Bit_Order,
     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,
@@ -521,9 +547,11 @@ package body Aspects is
     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,
@@ -543,7 +571,15 @@ package body Aspects is
     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,
@@ -554,6 +590,7 @@ package body Aspects is
     Aspect_Pre                          => Aspect_Pre,
     Aspect_Precondition                 => Aspect_Pre,
     Aspect_Predicate                    => Aspect_Predicate,
+    Aspect_Predicate_Failure            => Aspect_Predicate_Failure,
     Aspect_Preelaborate                 => Aspect_Preelaborate,
     Aspect_Preelaborable_Initialization => Aspect_Preelaborable_Initialization,
     Aspect_Priority                     => Aspect_Priority,
@@ -569,6 +606,7 @@ package body Aspects is
     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,
@@ -582,11 +620,13 @@ package body Aspects is
     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,
@@ -597,6 +637,8 @@ package body Aspects is
     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);