aspects.adb (Find_Aspect): New routine.

2013-04-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* aspects.adb (Find_Aspect): New routine.
	(Find_Value_Of_Aspect): New routine.
	(Has_Aspect): Reimplemented.
	* aspects.ads (Find_Aspect): New routine.
	(Find_Value_Of_Aspect): New routine, previously known as Find_Aspect.
	* exp_ch5.adb (Expand_Iterator_Loop): Update the call to Find_Aspect.
	* exp_util.adb (Is_Iterated_Container): Update the call to Find_Aspect.
	* sem_ch4.adb (Try_Container_Indexing): Update calls to Find_Aspect.
	* sem_ch5.adb (Analyze_Iterator_Specification): Update
	the call to Find_Aspect. Use function Has_Aspect for better
	readability.
	(Preanalyze_Range): Use function Has_Aspect for better readability.
	* sem_ch13.adb (Check_One_Function): Update the call to Find_Aspect.
	* sem_prag.adb (Analyze_Pragma): There is no longer need to
	look at the parent to extract the corresponding pragma for
	aspect Global.

From-SVN: r197911

gcc/ada/ChangeLog

+2013-04-12  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* aspects.adb (Find_Aspect): New routine.
+	(Find_Value_Of_Aspect): New routine.
+	(Has_Aspect): Reimplemented.
+	* aspects.ads (Find_Aspect): New routine.
+	(Find_Value_Of_Aspect): New routine, previously known as Find_Aspect.
+	* exp_ch5.adb (Expand_Iterator_Loop): Update the call to Find_Aspect.
+	* exp_util.adb (Is_Iterated_Container): Update the call to Find_Aspect.
+	* sem_ch4.adb (Try_Container_Indexing): Update calls to Find_Aspect.
+	* sem_ch5.adb (Analyze_Iterator_Specification): Update
+	the call to Find_Aspect. Use function Has_Aspect for better
+	readability.
+	(Preanalyze_Range): Use function Has_Aspect for better readability.
+	* sem_ch13.adb (Check_One_Function): Update the call to Find_Aspect.
+	* sem_prag.adb (Analyze_Pragma): There is no longer need to
+	look at the parent to extract the corresponding pragma for
+	aspect Global.
+
 2013-04-12  Robert Dewar  <dewar@adacore.com>
 
 	* checks.adb, sem_elab.adb, repinfo.adb, sem_ch4.adb, restrict.adb,

gcc/ada/aspects.adb

@@ -114,52 +114,91 @@ package body Aspects is
    -- Find_Aspect --
    -----------------
 
-   function Find_Aspect (Ent : Entity_Id; A : Aspect_Id) return Node_Id is
-      Ritem : Node_Id;
-      Typ   : Entity_Id;
+   function Find_Aspect (Id : Entity_Id; A : Aspect_Id) return Node_Id is
+      Decl  : Node_Id;
+      Item  : Node_Id;
+      Owner : Entity_Id;
+      Spec  : Node_Id;
 
    begin
+      Owner := Id;
 
-      --  If the aspect is an inherited one and the entity is a class-wide
-      --  type, use the aspect of the specific type. If the type is a base
-      --  aspect, examine the rep. items of the base type.
+      --  Handle various cases of base or inherited aspects for types
 
-      if Is_Type (Ent) then
+      if Is_Type (Id) then
          if Base_Aspect (A) then
-            Typ := Base_Type (Ent);
-         else
-            Typ := Ent;
+            Owner := Base_Type (Owner);
          end if;
 
-         if Is_Class_Wide_Type (Typ)
-           and then Inherited_Aspect (A)
-         then
-            Ritem := First_Rep_Item (Etype (Typ));
-         else
-            Ritem := First_Rep_Item (Typ);
+         if Is_Class_Wide_Type (Owner) and then Inherited_Aspect (A) then
+            Owner := Root_Type (Owner);
          end if;
-
-      else
-         Ritem := First_Rep_Item (Ent);
       end if;
 
-      while Present (Ritem) loop
-         if Nkind (Ritem) = N_Aspect_Specification
-           and then Get_Aspect_Id (Chars (Identifier (Ritem))) = A
+      --  Search the representation items for the desired aspect
+
+      Item := First_Rep_Item (Owner);
+      while Present (Item) loop
+         if Nkind (Item) = N_Aspect_Specification
+           and then Get_Aspect_Id (Chars (Identifier (Item))) = A
          then
-            if A = Aspect_Default_Iterator then
-               return Expression (Aspect_Rep_Item (Ritem));
-            else
-               return Expression (Ritem);
-            end if;
+            return Item;
          end if;
 
-         Next_Rep_Item (Ritem);
+         Next_Rep_Item (Item);
       end loop;
 
+      --  Note that not all aspects are added to the chain of representation
+      --  items. In such cases, search the list of aspect specifications. First
+      --  find the declaration node where the aspects reside. This is usually
+      --  the parent or the parent of the parent.
+
+      Decl := Parent (Owner);
+      if not Permits_Aspect_Specifications (Decl) then
+         Decl := Parent (Decl);
+      end if;
+
+      --  Search the list of aspect specifications for the desired aspect
+
+      if Permits_Aspect_Specifications (Decl) then
+         Spec := First (Aspect_Specifications (Decl));
+         while Present (Spec) loop
+            if Get_Aspect_Id (Chars (Identifier (Spec))) = A then
+               return Spec;
+            end if;
+
+            Next (Spec);
+         end loop;
+      end if;
+
+      --  The entity does not carry any aspects or the desired aspect was not
+      --  found.
+
       return Empty;
    end Find_Aspect;
 
+   --------------------------
+   -- Find_Value_Of_Aspect --
+   --------------------------
+
+   function Find_Value_Of_Aspect
+     (Id : Entity_Id;
+      A  : Aspect_Id) return Node_Id
+   is
+      Spec : constant Node_Id := Find_Aspect (Id, A);
+
+   begin
+      if Present (Spec) then
+         if A = Aspect_Default_Iterator then
+            return Expression (Aspect_Rep_Item (Spec));
+         else
+            return Expression (Spec);
+         end if;
+      end if;
+
+      return Empty;
+   end Find_Value_Of_Aspect;
+
    -------------------
    -- Get_Aspect_Id --
    -------------------
@@ -174,22 +213,8 @@ package body Aspects is
    ----------------
 
    function Has_Aspect (Id : Entity_Id; A : Aspect_Id) return Boolean is
-      Decl   : constant Node_Id := Parent (Parent (Id));
-      Aspect : Node_Id;
-
    begin
-      if Has_Aspects (Decl) then
-         Aspect := First (Aspect_Specifications (Decl));
-         while Present (Aspect) loop
-            if Get_Aspect_Id (Chars (Identifier (Aspect))) = A then
-               return True;
-            end if;
-
-            Next (Aspect);
-         end loop;
-      end if;
-
-      return False;
+      return Present (Find_Aspect (Id, A));
    end Has_Aspect;
 
    ------------------

gcc/ada/aspects.ads

@@ -517,8 +517,15 @@ package Aspects is
    --  Replace calls, and this function may be used to retrieve the aspect
    --  specifications for the original rewritten node in such cases.
 
-   function Find_Aspect (Ent : Entity_Id; A : Aspect_Id) return Node_Id;
-   --  Find value of a given aspect from aspect list of entity
+   function Find_Aspect (Id : Entity_Id; A : Aspect_Id) return Node_Id;
+   --  Find the aspect specification of aspect A associated with entity I.
+   --  Return Empty if Id does not have the requested aspect.
+
+   function Find_Value_Of_Aspect
+     (Id : Entity_Id;
+      A  : Aspect_Id) return Node_Id;
+   --  Find the value of aspect A associated with entity Id. Return Empty if
+   --  Id does not have the requested aspect.
 
    function Has_Aspect (Id : Entity_Id; A : Aspect_Id) return Boolean;
    --  Determine whether entity Id has aspect A

gcc/ada/exp_ch5.adb

@@ -3377,7 +3377,7 @@ package body Exp_Ch5 is
             declare
                Default_Iter : constant Entity_Id :=
                                 Entity
-                                  (Find_Aspect
+                                  (Find_Value_Of_Aspect
                                     (Etype (Container),
                                      Aspect_Default_Iterator));
 

gcc/ada/exp_util.adb

@@ -4298,7 +4298,7 @@ package body Exp_Util is
          --  Look for aspect Default_Iterator
 
          if Has_Aspects (Parent (Typ)) then
-            Aspect := Find_Aspect (Typ, Aspect_Default_Iterator);
+            Aspect := Find_Value_Of_Aspect (Typ, Aspect_Default_Iterator);
 
             if Present (Aspect) then
                Iter := Entity (Aspect);

gcc/ada/sem_ch13.adb

@@ -1226,11 +1226,10 @@ package body Sem_Ch13 is
                       Pragma_Identifier            =>
                         Make_Identifier (Sloc (Id), Chars (Id)));
 
-               when Aspect_Synchronization =>
-
-                  --  The aspect corresponds to pragma Implemented.
-                  --  Construct the pragma.
+               --  The aspect corresponds to pragma Implemented. Construct the
+               --  pragma.
 
+               when Aspect_Synchronization =>
                   Aitem :=
                     Make_Pragma (Loc,
                       Pragma_Argument_Associations => New_List (
@@ -2338,7 +2337,7 @@ package body Sem_Ch13 is
 
          procedure Check_One_Function (Subp : Entity_Id) is
             Default_Element : constant Node_Id :=
-                                Find_Aspect
+                                Find_Value_Of_Aspect
                                   (Etype (First_Formal (Subp)),
                                    Aspect_Iterator_Element);
 

gcc/ada/sem_ch4.adb

@@ -6717,11 +6717,13 @@ package body Sem_Ch4 is
       Func_Name := Empty;
 
       if Is_Variable (Prefix) then
-         Func_Name := Find_Aspect (Etype (Prefix), Aspect_Variable_Indexing);
+         Func_Name :=
+           Find_Value_Of_Aspect (Etype (Prefix), Aspect_Variable_Indexing);
       end if;
 
       if No (Func_Name) then
-         Func_Name := Find_Aspect (Etype (Prefix), Aspect_Constant_Indexing);
+         Func_Name :=
+           Find_Value_Of_Aspect (Etype (Prefix), Aspect_Constant_Indexing);
       end if;
 
       --  If aspect does not exist the expression is illegal. Error is

gcc/ada/sem_ch5.adb

@@ -1789,7 +1789,7 @@ package body Sem_Ch5 is
 
             declare
                Element : constant Entity_Id :=
-                           Find_Aspect (Typ, Aspect_Iterator_Element);
+                           Find_Value_Of_Aspect (Typ, Aspect_Iterator_Element);
             begin
                if No (Element) then
                   Error_Msg_NE ("cannot iterate over&", N, Typ);
@@ -1800,7 +1800,7 @@ package body Sem_Ch5 is
                   --  If the container has a variable indexing aspect, the
                   --  element is a variable and is modifiable in the loop.
 
-                  if Present (Find_Aspect (Typ, Aspect_Variable_Indexing)) then
+                  if Has_Aspect (Typ, Aspect_Variable_Indexing) then
                      Set_Ekind (Def_Id, E_Variable);
                   end if;
                end if;
@@ -1814,7 +1814,7 @@ package body Sem_Ch5 is
             if Is_Entity_Name (Original_Node (Name (N)))
               and then not Is_Iterator (Typ)
             then
-               if No (Find_Aspect (Typ, Aspect_Iterator_Element)) then
+               if not Has_Aspect (Typ, Aspect_Iterator_Element) then
                   Error_Msg_NE
                     ("cannot iterate over&", Name (N), Typ);
                else
@@ -3044,9 +3044,9 @@ package body Sem_Ch5 is
 
          --  Check that the resulting object is an iterable container
 
-         elsif Present (Find_Aspect (Typ, Aspect_Iterator_Element))
-           or else Present (Find_Aspect (Typ, Aspect_Constant_Indexing))
-           or else Present (Find_Aspect (Typ, Aspect_Variable_Indexing))
+         elsif Has_Aspect (Typ, Aspect_Iterator_Element)
+           or else Has_Aspect (Typ, Aspect_Constant_Indexing)
+           or else Has_Aspect (Typ, Aspect_Variable_Indexing)
          then
             null;
 

gcc/ada/sem_prag.adb

@@ -9620,7 +9620,7 @@ package body Sem_Prag is
 
                   --  Retrieve the pragma as it contains the analyzed lists
 
-                  Global := Aspect_Rep_Item (Parent (Global));
+                  Global := Aspect_Rep_Item (Global);
 
                   --  The pragma may not have been analyzed because of the
                   --  arbitrary declaration order of aspects. Make sure that