OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Hristian Kirtchev 2013-04-12 13:20:29 +00:00 committed by Arnaud Charlet
parent 489c6e198e
commit d62520f3cf
9 changed files with 113 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/ada/ChangeLog
View File

@ -1,3 +1,22 @@
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,

111
gcc/ada/aspects.adb
View File

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

11
gcc/ada/aspects.ads
View File

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

2
gcc/ada/exp_ch5.adb
View File

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

2
gcc/ada/exp_util.adb
View File

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

9
gcc/ada/sem_ch13.adb
View File

@ -1226,11 +1226,10 @@ package body Sem_Ch13 is
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Chars (Id)));
-- The aspect corresponds to pragma Implemented. Construct the
-- pragma.
when Aspect_Synchronization =>
-- The aspect corresponds to pragma Implemented.
-- Construct the pragma.
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);

6
gcc/ada/sem_ch4.adb
View File

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

12
gcc/ada/sem_ch5.adb
View File

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

2
gcc/ada/sem_prag.adb
View File

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