[multiple changes]

2013-04-23  Ed Schonberg  <schonberg@adacore.com>

	* 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  <kirtchev@adacore.com>

	* 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

1 files changed, 38 insertions, 2 deletions

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 --
    ----------------