diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 12 | ||||
| -rw-r--r-- | gcc/ada/einfo.adb | 44 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 11 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 45 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 6 |
5 files changed, 69 insertions, 49 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 21f43ac..cf49b9d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2013-04-25 Robert Dewar <dewar@adacore.com> + + * einfo.ads, einfo.adb: Put back with/use for Namet. + (Get_Pragma): New name (wi new spec) for Find_Pragma. + * sem_ch6.adb: Change name Find_Pragma to Get_Pragma with + different interface. + +2013-04-25 Ed Schonberg <schonberg@adacore.com> + + * sem_ch3.adb (Is_Visible_Component): In an instance all + components are visible. + 2013-04-25 Matthew Heaney <heaney@adacore.com> * a-rbtgbo.adb, a-crbtgo.adb (Generic_Equal): do not test for diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 81b35f7..31a90e3 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -33,6 +33,7 @@ pragma Style_Checks (All_Checks); -- Turn off subprogram ordering, not used for this unit with Atree; use Atree; +with Namet; use Namet; with Nlists; use Nlists; with Output; use Output; with Sinfo; use Sinfo; @@ -6101,26 +6102,6 @@ package body Einfo is return Etype (Discrete_Subtype_Definition (Parent (Id))); end Entry_Index_Type; - ----------------- - -- Find_Pragma -- - ----------------- - - function Find_Pragma (Id : Entity_Id; Name : Name_Id) return Node_Id is - Item : Node_Id; - - begin - Item := First_Rep_Item (Id); - while Present (Item) loop - if Nkind (Item) = N_Pragma and then Pragma_Name (Item) = Name then - return Item; - end if; - - Item := Next_Rep_Item (Item); - end loop; - - return Empty; - end Find_Pragma; - --------------------- -- First_Component -- --------------------- @@ -6264,6 +6245,29 @@ package body Einfo is end if; end Get_Full_View; + ---------------- + -- Get_Pragma -- + ---------------- + + function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id + is + N : Node_Id; + + begin + N := First_Rep_Item (E); + while Present (N) loop + if Nkind (N) = N_Pragma + and then Get_Pragma_Id (Pragma_Name (N)) = Id + then + return N; + else + Next_Rep_Item (N); + end if; + end loop; + + return Empty; + end Get_Pragma; + -------------------------------------- -- Get_Record_Representation_Clause -- -------------------------------------- diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index bd58928..a3d05d8 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -29,7 +29,6 @@ -- -- ------------------------------------------------------------------------------ -with Namet; use Namet; with Snames; use Snames; with Types; use Types; with Uintp; use Uintp; @@ -7354,11 +7353,6 @@ package Einfo is -- expression is deferred to the freeze point. For further details see -- Sem_Ch13.Analyze_Aspect_Specifications. - function Find_Pragma (Id : Entity_Id; Name : Name_Id) return Node_Id; - -- Given entity Id and pragma name Name, attempt to find the corresponding - -- pragma in Id's chain of representation items. The function returns Empty - -- if no such pragma has been found. - function Get_Attribute_Definition_Clause (E : Entity_Id; Id : Attribute_Id) return Node_Id; @@ -7367,6 +7361,11 @@ package Einfo is -- value returned is the N_Attribute_Definition_Clause node, otherwise -- Empty is returned. + function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id; + -- Searches the Rep_Item chain for a given entity E, for an instance of + -- a pragma with the given pragma Id. If found, the value returned is the + -- N_Pragma node, otherwise Empty is returned. + function Get_Record_Representation_Clause (E : Entity_Id) return Node_Id; -- Searches the Rep_Item chain for a given entity E, for a record -- representation clause, and if found, returns it. Returns Empty diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 29abd55..dc9c4df 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -1230,11 +1230,11 @@ package body Sem_Ch3 is Check_For_Premature_Usage (T_Def); - -- The return type and/or any parameter type may be incomplete. Mark - -- the subprogram_type as depending on the incomplete type, so that - -- it can be updated when the full type declaration is seen. This - -- only applies to incomplete types declared in some enclosing scope, - -- not to limited views from other packages. + -- The return type and/or any parameter type may be incomplete. Mark the + -- subprogram_type as depending on the incomplete type, so that it can + -- be updated when the full type declaration is seen. This only applies + -- to incomplete types declared in some enclosing scope, not to limited + -- views from other packages. if Present (Formals) then Formal := First_Formal (Desig_Type); @@ -1256,9 +1256,9 @@ package body Sem_Ch3 is end loop; end if; - -- If the return type is incomplete, this is legal as long as the - -- type is declared in the current scope and will be completed in - -- it (rather than being part of limited view). + -- If the return type is incomplete, this is legal as long as the type + -- is declared in the current scope and will be completed in it (rather + -- than being part of limited view). if Ekind (Etype (Desig_Type)) = E_Incomplete_Type and then not Has_Delayed_Freeze (Desig_Type) @@ -1331,9 +1331,9 @@ package body Sem_Ch3 is if Base_Type (Full_Desig) = T then Error_Msg_N ("access type cannot designate itself", S); - -- In Ada 2005, the type may have a limited view through some unit - -- in its own context, allowing the following circularity that cannot - -- be detected earlier + -- In Ada 2005, the type may have a limited view through some unit in + -- its own context, allowing the following circularity that cannot be + -- detected earlier elsif Is_Class_Wide_Type (Full_Desig) and then Etype (Full_Desig) = T @@ -1348,8 +1348,8 @@ package body Sem_Ch3 is Set_Etype (T, T); - -- If the type has appeared already in a with_type clause, it is - -- frozen and the pointer size is already set. Else, initialize. + -- If the type has appeared already in a with_type clause, it is frozen + -- and the pointer size is already set. Else, initialize. if not From_With_Type (T) then Init_Size_Align (T); @@ -16468,15 +16468,16 @@ package body Sem_Ch3 is Type_Scope := Scope (Base_Type (Scope (C))); end if; - -- For an untagged type derived from a private type, the only - -- visible components are new discriminants. + -- For an untagged type derived from a private type, the only visible + -- components are new discriminants. In an instance all components are + -- visible (see Analyze_Selected_Component). if not Is_Tagged_Type (Original_Scope) then return not Has_Private_Ancestor (Original_Scope) - or else In_Open_Scopes (Scope (Original_Scope)) - or else - (Ekind (Original_Comp) = E_Discriminant - and then Original_Scope = Type_Scope); + or else In_Open_Scopes (Scope (Original_Scope)) + or else In_Instance + or else (Ekind (Original_Comp) = E_Discriminant + and then Original_Scope = Type_Scope); -- If it is _Parent or _Tag, there is no visibility issue @@ -16545,9 +16546,9 @@ package body Sem_Ch3 is and then Is_Local_Type (Type_Scope); end if; - -- There is another weird way in which a component may be invisible - -- when the private and the full view are not derived from the same - -- ancestor. Here is an example : + -- There is another weird way in which a component may be invisible when + -- the private and the full view are not derived from the same ancestor. + -- Here is an example : -- type A1 is tagged record F1 : integer; end record; -- type A2 is new A1 with record F2 : integer; end record; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 4b13429..3d709cf 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -11908,9 +11908,13 @@ package body Sem_Ch6 is -- because the input type may lack aspect/pragma predicate and simply -- inherit those from its ancestor. + -- Note that predicate pragmas include all three cases of predicate + -- aspects (Predicate, Dynamic_Predicate, Static_Predicate), so this + -- routine checks for all three cases. + Anc := Typ; while Present (Anc) loop - Pred := Find_Pragma (Anc, Name_Predicate); + Pred := Get_Pragma (Anc, Pragma_Predicate); if Present (Pred) and then not Is_Ignored (Pred) then return True; |