[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

gcc/ada/ChangeLog

+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.
+
 2013-04-23  Robert Dewar  <dewar@adacore.com>
 
 	* sem_prag.adb (Fix_Error): Rewrite to do more accurate job

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

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;

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

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

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

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;