From f06f5f6bd618153d66a028f7be4dbecc22913ac1 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 20 Oct 2015 11:45:29 +0200 Subject: [PATCH] [multiple changes] 2015-10-20 Thomas Quinot * types.ads: Minor reformatting. 2015-10-20 Hristian Kirtchev * einfo.adb (Get_Pragma): Minor reformatting. Rename local constant Is_CDG to Is_CLS. Add pragma Constant_After_Elaboration to the list of classification pragmas. 2015-10-20 Ed Schonberg * sem_ch3.adb (Analyze_Declarations); At the of the visible part, perform name resolution on the expressions in aspects of visible entities. * sem_ch13.ads, sem_ch13.adb (Resolve_Aspect_Expressions): Resolve expressions in aspects independently of whether corresponding entity is frozen. Used to complete name resolution of aspect expressions for entities declared in the visible part of a package or generic package declaration. From-SVN: r229028 --- gcc/ada/ChangeLog | 21 ++++++++++++++ gcc/ada/einfo.adb | 50 +++++++++++++++++++------------- gcc/ada/sem_ch13.adb | 69 ++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/sem_ch13.ads | 7 +++++ gcc/ada/sem_ch3.adb | 23 +++++++++++++++ gcc/ada/types.ads | 2 +- 6 files changed, 151 insertions(+), 21 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3b1a4eb2538..1ecd52f9131 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2015-10-20 Thomas Quinot + + * types.ads: Minor reformatting. + +2015-10-20 Hristian Kirtchev + + * einfo.adb (Get_Pragma): Minor reformatting. Rename local constant + Is_CDG to Is_CLS. Add pragma Constant_After_Elaboration to the list of + classification pragmas. + +2015-10-20 Ed Schonberg + + * sem_ch3.adb (Analyze_Declarations); At the of the visible part, + perform name resolution on the expressions in aspects of visible + entities. + * sem_ch13.ads, sem_ch13.adb (Resolve_Aspect_Expressions): Resolve + expressions in aspects independently of whether corresponding + entity is frozen. Used to complete name resolution of aspect + expressions for entities declared in the visible part of a + package or generic package declaration. + 2015-10-20 Vincent Celier * prj-attr.adb: Add package Codepeer and its attributes. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 6dd5c96abc2..8888d772d51 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -6980,30 +6980,40 @@ package body Einfo is ---------------- function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id is - Is_CDG : constant Boolean := - Id = Pragma_Abstract_State or else - Id = Pragma_Async_Readers or else - Id = Pragma_Async_Writers or else - Id = Pragma_Depends or else - Id = Pragma_Effective_Reads or else - Id = Pragma_Effective_Writes or else - Id = Pragma_Extensions_Visible or else - Id = Pragma_Global or else - Id = Pragma_Initial_Condition or else - Id = Pragma_Initializes or else - Id = Pragma_Part_Of or else - Id = Pragma_Refined_Depends or else - Id = Pragma_Refined_Global or else - Id = Pragma_Refined_State; + + -- Classification pragmas + + Is_CLS : constant Boolean := + Id = Pragma_Abstract_State or else + Id = Pragma_Async_Readers or else + Id = Pragma_Async_Writers or else + Id = Pragma_Constant_After_Elaboration or else + Id = Pragma_Depends or else + Id = Pragma_Effective_Reads or else + Id = Pragma_Effective_Writes or else + Id = Pragma_Extensions_Visible or else + Id = Pragma_Global or else + Id = Pragma_Initial_Condition or else + Id = Pragma_Initializes or else + Id = Pragma_Part_Of or else + Id = Pragma_Refined_Depends or else + Id = Pragma_Refined_Global or else + Id = Pragma_Refined_State; + + -- Contract / test case pragmas + Is_CTC : constant Boolean := - Id = Pragma_Contract_Cases or else + Id = Pragma_Contract_Cases or else Id = Pragma_Test_Case; + + -- Pre / postcondition pragmas + Is_PPC : constant Boolean := - Id = Pragma_Precondition or else - Id = Pragma_Postcondition or else + Id = Pragma_Precondition or else + Id = Pragma_Postcondition or else Id = Pragma_Refined_Post; - In_Contract : constant Boolean := Is_CDG or Is_CTC or Is_PPC; + In_Contract : constant Boolean := Is_CLS or Is_CTC or Is_PPC; Item : Node_Id; Items : Node_Id; @@ -7018,7 +7028,7 @@ package body Einfo is if No (Items) then return Empty; - elsif Is_CDG then + elsif Is_CLS then Item := Classifications (Items); elsif Is_CTC then diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index c3af7ce488b..59c6e949d30 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -12382,6 +12382,75 @@ package body Sem_Ch13 is Replace_Type_Refs (N); end Replace_Type_References_Generic; + -------------------------------- + -- Resolve_Aspect_Expressions -- + -------------------------------- + + procedure Resolve_Aspect_Expressions (E : Entity_Id) is + ASN : Node_Id; + A_Id : Aspect_Id; + Expr : Node_Id; + + begin + ASN := First_Rep_Item (E); + while Present (ASN) loop + if Nkind (ASN) = N_Aspect_Specification and then Entity (ASN) = E then + A_Id := Get_Aspect_Id (ASN); + Expr := Expression (ASN); + + case A_Id is + -- For now we only deal with aspects that do not generate + -- subprograms, or that may mention current instances of + -- types. These will require special handling (TBD). + + when Aspect_Predicate | + Aspect_Invariant | + Aspect_Static_Predicate | + Aspect_Dynamic_Predicate => + null; + + when Pre_Post_Aspects => + null; + + when Aspect_Iterable => + if Nkind (Expr) = N_Aggregate then + declare + Assoc : Node_Id; + + begin + Assoc := First (Component_Associations (Expr)); + while Present (Assoc) loop + Find_Direct_Name (Expression (Assoc)); + Next (Assoc); + end loop; + end; + end if; + + when others => + if Present (Expr) then + case Aspect_Argument (A_Id) is + when Expression | Optional_Expression => + Analyze_And_Resolve (Expression (ASN)); + + when Name | Optional_Name => + if Nkind (Expr) = N_Identifier then + Find_Direct_Name (Expr); + + elsif Nkind (Expr) = N_Selected_Component then + Find_Selected_Component (Expr); + + else + null; + end if; + end case; + end if; + end case; + end if; + + Next (ASN); + end loop; + end Resolve_Aspect_Expressions; + ------------------------- -- Same_Representation -- ------------------------- diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index df779086065..8ae92941099 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -347,6 +347,13 @@ package Sem_Ch13 is -- Given an entity Typ that denotes a derived type or a subtype, this -- routine performs the inheritance of aspects at the freeze point. + procedure Resolve_Aspect_Expressions (E : Entity_Id); + -- Name resolution of an aspect expression happens at the end of the + -- current declarative part or at the freeze point for the entity, + -- whichever comes first. For declarations in the visible part of a + -- package, name resolution takes place before analysis of the private + -- part even though the freeze point of the entity may appear later. + procedure Validate_Iterable_Aspect (Typ : Entity_Id; ASN : Node_Id); -- For SPARK 2014 formal containers. The expression has the form of an -- aggregate, and each entry must denote a function with the proper syntax diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 2649f4d8bb4..b8f901da512 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2391,6 +2391,29 @@ package body Sem_Ch3 is Adjust_Decl; Freeze_All (First_Entity (Current_Scope), Decl); Freeze_From := Last_Entity (Current_Scope); + + -- At the end of the visible declarations the expressions in + -- aspects of all entities declared so far must be resolved. + -- The entities themselves might be frozen later, and the + -- generated pragmas and attribute definition clauses analyzed + -- in full at that point, but name resolution must take place + -- now. + -- In addition to being the proper semantics, this is mandatory + -- within generic units, because global name capture requires + -- those expressions to be analyzed, given that the generated + -- pragmas do not appear in the original generic tree. + + elsif Serious_Errors_Detected = 0 then + declare + E : Entity_Id; + + begin + E := First_Entity (Current_Scope); + while Present (E) loop + Resolve_Aspect_Expressions (E); + Next_Entity (E); + end loop; + end; end if; -- If next node is a body then freeze all types before the body. diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 7a19dee126e..af772fa70fc 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -629,7 +629,7 @@ package Types is -- copying operations during installation. We have particularly noticed -- that WinNT seems susceptible to such changes. -- - -- Note : the Empty_Time_Stamp value looks equal to itself, and less than + -- Note: the Empty_Time_Stamp value looks equal to itself, and less than -- any non-empty time stamp value. procedure Split_Time_Stamp -- 2.30.2