diff options
Diffstat (limited to 'gcc/ada/sem_aux.adb')
| -rw-r--r-- | gcc/ada/sem_aux.adb | 108 |
1 files changed, 47 insertions, 61 deletions
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index e5bd68a..4a16c12 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -32,6 +32,7 @@ with Atree; use Atree; with Einfo; use Einfo; +with Nlists; use Nlists; with Snames; use Snames; with Stand; use Stand; with Uintp; use Uintp; @@ -234,7 +235,7 @@ package body Sem_Aux is -- either because the tag must be ahead of them. if Chars (Ent) = Name_uTag then - Ent := Next_Entity (Ent); + Next_Entity (Ent); end if; -- Skip all hidden stored discriminants if any @@ -243,7 +244,7 @@ package body Sem_Aux is exit when Ekind (Ent) = E_Discriminant and then not Is_Completely_Hidden (Ent); - Ent := Next_Entity (Ent); + Next_Entity (Ent); end loop; -- Call may be on a private type with unknown discriminants, in which @@ -297,7 +298,7 @@ package body Sem_Aux is return True; end if; - Ent := Next_Entity (Ent); + Next_Entity (Ent); end loop; return False; @@ -313,14 +314,14 @@ package body Sem_Aux is Ent := First_Entity (Typ); if Chars (Ent) = Name_uTag then - Ent := Next_Entity (Ent); + Next_Entity (Ent); end if; if Has_Completely_Hidden_Discriminant (Ent) then while Present (Ent) loop exit when Ekind (Ent) = E_Discriminant and then Is_Completely_Hidden (Ent); - Ent := Next_Entity (Ent); + Next_Entity (Ent); end loop; end if; @@ -344,8 +345,8 @@ package body Sem_Aux is -- predefined integer types. If the type is formal, it is also a first -- subtype, and its base type has no freeze node. On the other hand, a -- subtype of a generic formal is not its own first subtype. Its base - -- type, if anonymous, is attached to the formal type decl. from which - -- the first subtype is obtained. + -- type, if anonymous, is attached to the formal type declaration from + -- which the first subtype is obtained. if No (F) then if B = Base_Type (Standard_Integer) then @@ -423,7 +424,7 @@ package body Sem_Aux is return Comp; end if; - Comp := Next_Entity (Comp); + Next_Entity (Comp); end loop; -- No tag component found @@ -485,19 +486,6 @@ package body Sem_Aux is return Id; end Get_Called_Entity; - ------------------- - -- Get_Low_Bound -- - ------------------- - - function Get_Low_Bound (E : Entity_Id) return Node_Id is - begin - if Ekind (E) = E_String_Literal_Subtype then - return String_Literal_Low_Bound (E); - else - return Type_Low_Bound (E); - end if; - end Get_Low_Bound; - ------------------ -- Get_Rep_Item -- ------------------ @@ -723,11 +711,11 @@ package body Sem_Aux is begin pragma Assert - (Nkind_In (N, N_Aspect_Specification, - N_Attribute_Definition_Clause, - N_Enumeration_Representation_Clause, - N_Pragma, - N_Record_Representation_Clause)); + (Nkind (N) in N_Aspect_Specification + | N_Attribute_Definition_Clause + | N_Enumeration_Representation_Clause + | N_Pragma + | N_Record_Representation_Clause); Item := First_Rep_Item (E); while Present (Item) loop @@ -735,7 +723,7 @@ package body Sem_Aux is return True; end if; - Item := Next_Rep_Item (Item); + Next_Rep_Item (Item); end loop; return False; @@ -889,13 +877,9 @@ package body Sem_Aux is function Is_Body (N : Node_Id) return Boolean is begin - return - Nkind (N) in N_Body_Stub - or else Nkind_In (N, N_Entry_Body, - N_Package_Body, - N_Protected_Body, - N_Subprogram_Body, - N_Task_Body); + return Nkind (N) in + N_Body_Stub | N_Entry_Body | N_Package_Body | N_Protected_Body | + N_Subprogram_Body | N_Task_Body; end Is_Body; --------------------- @@ -984,7 +968,7 @@ package body Sem_Aux is return True; end if; - C := Next_Component (C); + Next_Component (C); end loop; end; @@ -1084,8 +1068,7 @@ package body Sem_Aux is Kind := Nkind (Original_Node (Parent (E))); return - Nkind_In (Kind, N_Formal_Object_Declaration, - N_Formal_Type_Declaration) + Kind in N_Formal_Object_Declaration | N_Formal_Type_Declaration or else Is_Formal_Subprogram (E) or else (Ekind (E) = E_Package @@ -1216,7 +1199,7 @@ package body Sem_Aux is return True; end if; - C := Next_Component (C); + Next_Component (C); end loop; end; @@ -1315,7 +1298,7 @@ package body Sem_Aux is return True; end if; - C := Next_Component (C); + Next_Component (C); end loop; end; @@ -1343,6 +1326,15 @@ package body Sem_Aux is N_Protected_Definition); end Is_Protected_Operation; + ------------------------------- + -- Is_Record_Or_Limited_Type -- + ------------------------------- + + function Is_Record_Or_Limited_Type (Typ : Entity_Id) return Boolean is + begin + return Is_Record_Type (Typ) or else Is_Limited_Type (Typ); + end Is_Record_Or_Limited_Type; + ---------------------- -- Nearest_Ancestor -- ---------------------- @@ -1379,6 +1371,18 @@ package body Sem_Aux is end if; end; + -- If this is a concurrent declaration with a nonempty interface list, + -- get the first progenitor. Account for case of a record type created + -- for a concurrent type (which is the only case that seems to occur + -- in practice). + + elsif Nkind (D) = N_Full_Type_Declaration + and then (Is_Concurrent_Type (Defining_Identifier (D)) + or else Is_Concurrent_Record_Type (Defining_Identifier (D))) + and then Is_Non_Empty_List (Interface_List (Type_Definition (D))) + then + return Entity (First (Interface_List (Type_Definition (D)))); + -- If derived type and private type, get the full view to find who we -- are derived from. @@ -1427,7 +1431,7 @@ package body Sem_Aux is return Comp; end if; - Comp := Next_Entity (Comp); + Next_Entity (Comp); end loop; -- No tag component found @@ -1456,7 +1460,7 @@ package body Sem_Aux is while Present (Comp) loop N := N + 1; - Comp := Next_Component_Or_Discriminant (Comp); + Next_Component_Or_Discriminant (Comp); end loop; return N; @@ -1473,7 +1477,7 @@ package body Sem_Aux is begin while Present (Discr) loop N := N + 1; - Discr := Next_Discriminant (Discr); + Next_Discriminant (Discr); end loop; return N; @@ -1650,24 +1654,6 @@ package body Sem_Aux is return N; end Subprogram_Specification; - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - begin - Obsolescent_Warnings.Tree_Read; - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - Obsolescent_Warnings.Tree_Write; - end Tree_Write; - -------------------- -- Ultimate_Alias -- -------------------- |