diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3a29f199b18..a4abd21692d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2013-04-12 Hristian Kirtchev + + * 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 * checks.adb, sem_elab.adb, repinfo.adb, sem_ch4.adb, restrict.adb, diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 7799fa83a70..364f8572476 100644 --- a/gcc/ada/aspects.adb +++ b/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; ------------------ diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index e282f1a6afc..2194eb33834 100644 --- a/gcc/ada/aspects.ads +++ b/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 diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 243279b00fc..825ea1bd18d 100644 --- a/gcc/ada/exp_ch5.adb +++ b/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)); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 69e16c99689..02384fd1491 100644 --- a/gcc/ada/exp_util.adb +++ b/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); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 89364c3794e..6d4a60954b1 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -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); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 7ac29bb14df..6ff707ab9e4 100644 --- a/gcc/ada/sem_ch4.adb +++ b/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 diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index d098609d5c5..6f57730e151 100644 --- a/gcc/ada/sem_ch5.adb +++ b/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; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 240eb0c7684..d60c41ef956 100644 --- a/gcc/ada/sem_prag.adb +++ b/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