+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,
-- 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 --
-------------------
----------------
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;
------------------
-- 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
declare
Default_Iter : constant Entity_Id :=
Entity
- (Find_Aspect
+ (Find_Value_Of_Aspect
(Etype (Container),
Aspect_Default_Iterator));
-- 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);
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 (
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);
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
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);
-- 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;
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
-- 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;
-- 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
projects / thirdparty / gcc.git / commitdiff
