diff options
Diffstat (limited to 'gcc/ada/sem_ch3.adb')
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 222 |
1 files changed, 106 insertions, 116 deletions
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 6cc315c..96f05a5 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -751,8 +751,8 @@ package body Sem_Ch3 is -- function, scope is the current one, because it is the one of the -- current type declaration, except for the pathological case below. - if Nkind_In (Related_Nod, N_Object_Declaration, - N_Access_Function_Definition) + if Nkind (Related_Nod) in + N_Object_Declaration | N_Access_Function_Definition then Anon_Scope := Current_Scope; @@ -765,8 +765,8 @@ package body Sem_Ch3 is begin Par := Related_Nod; - while Nkind_In (Par, N_Access_Function_Definition, - N_Access_Definition) + while Nkind (Par) in + N_Access_Function_Definition | N_Access_Definition loop Par := Parent (Par); end loop; @@ -1078,20 +1078,18 @@ package body Sem_Ch3 is -- (Z : access T))) D_Ityp := Associated_Node_For_Itype (Desig_Type); - while not (Nkind_In (D_Ityp, N_Full_Type_Declaration, - N_Private_Type_Declaration, - N_Private_Extension_Declaration, - N_Procedure_Specification, - N_Function_Specification, - N_Entry_Body) - - or else - Nkind_In (D_Ityp, N_Object_Declaration, - N_Object_Renaming_Declaration, - N_Formal_Object_Declaration, - N_Formal_Type_Declaration, - N_Task_Type_Declaration, - N_Protected_Type_Declaration)) + while Nkind (D_Ityp) not in N_Full_Type_Declaration + | N_Private_Type_Declaration + | N_Private_Extension_Declaration + | N_Procedure_Specification + | N_Function_Specification + | N_Entry_Body + | N_Object_Declaration + | N_Object_Renaming_Declaration + | N_Formal_Object_Declaration + | N_Formal_Type_Declaration + | N_Task_Type_Declaration + | N_Protected_Type_Declaration loop D_Ityp := Parent (D_Ityp); pragma Assert (D_Ityp /= Empty); @@ -1099,15 +1097,14 @@ package body Sem_Ch3 is Set_Associated_Node_For_Itype (Desig_Type, D_Ityp); - if Nkind_In (D_Ityp, N_Procedure_Specification, - N_Function_Specification) + if Nkind (D_Ityp) in N_Procedure_Specification | N_Function_Specification then Set_Scope (Desig_Type, Scope (Defining_Entity (D_Ityp))); - elsif Nkind_In (D_Ityp, N_Full_Type_Declaration, - N_Object_Declaration, - N_Object_Renaming_Declaration, - N_Formal_Type_Declaration) + elsif Nkind (D_Ityp) in N_Full_Type_Declaration + | N_Object_Declaration + | N_Object_Renaming_Declaration + | N_Formal_Type_Declaration then Set_Scope (Desig_Type, Scope (Defining_Identifier (D_Ityp))); end if; @@ -2349,9 +2346,9 @@ package body Sem_Ch3 is -- because they have already been resolved. elsif Decls = Visible_Declarations (Context) - and then Ekind_In (Typ, E_Limited_Private_Type, - E_Private_Type, - E_Record_Type_With_Private) + and then Ekind (Typ) in E_Limited_Private_Type + | E_Private_Type + | E_Record_Type_With_Private and then Has_Own_Invariants (Typ) then Build_Invariant_Procedure_Body @@ -2496,9 +2493,9 @@ package body Sem_Ch3 is -- controlled primitives. if Nkind (Body_Spec) /= N_Procedure_Specification - or else not Nam_In (Chars (Body_Id), Name_Adjust, - Name_Finalize, - Name_Initialize) + or else Chars (Body_Id) not in Name_Adjust + | Name_Finalize + | Name_Initialize then return; @@ -2533,7 +2530,7 @@ package body Sem_Ch3 is Spec_Id := Current_Entity (Body_Id); while Present (Spec_Id) loop - if Ekind_In (Spec_Id, E_Procedure, E_Generic_Procedure) + if Ekind (Spec_Id) in E_Procedure | E_Generic_Procedure and then Scope (Spec_Id) = Current_Scope and then Present (First_Formal (Spec_Id)) and then No (Next_Formal (First_Formal (Spec_Id))) @@ -2672,8 +2669,8 @@ package body Sem_Ch3 is if Nkind (Parent (L)) = N_Component_List then null; - elsif Nkind_In (Parent (L), N_Protected_Definition, - N_Task_Definition) + elsif Nkind (Parent (L)) in + N_Protected_Definition | N_Task_Definition then Check_Entry_Contracts; @@ -3613,7 +3610,7 @@ package body Sem_Ch3 is return; end if; - if Nkind_In (E, N_Integer_Literal, N_Real_Literal) then + if Nkind (E) in N_Integer_Literal | N_Real_Literal then Set_Etype (E, Etype (Id)); end if; @@ -5086,7 +5083,7 @@ package body Sem_Ch3 is ("parent of type extension must be a tagged type ", Indic); goto Leave; - elsif Ekind_In (Parent_Type, E_Void, E_Incomplete_Type) then + elsif Ekind (Parent_Type) in E_Void | E_Incomplete_Type then Error_Msg_N ("premature derivation of incomplete type", Indic); goto Leave; @@ -6436,7 +6433,7 @@ package body Sem_Ch3 is Mark_Rewrite_Insertion (Comp); - if Nkind_In (N, N_Object_Declaration, N_Access_Function_Definition) + if Nkind (N) in N_Object_Declaration | N_Access_Function_Definition or else (Nkind (Parent (N)) = N_Full_Type_Declaration and then not Is_Type (Current_Scope)) then @@ -6512,10 +6509,10 @@ package body Sem_Ch3 is end Replace_Type_Name; begin - if Ekind_In (Id, E_Access_Subprogram_Type, - E_Access_Protected_Subprogram_Type, - E_Anonymous_Access_Protected_Subprogram_Type, - E_Anonymous_Access_Subprogram_Type) + if Ekind (Id) in E_Access_Subprogram_Type + | E_Access_Protected_Subprogram_Type + | E_Anonymous_Access_Protected_Subprogram_Type + | E_Anonymous_Access_Subprogram_Type then null; @@ -10478,9 +10475,9 @@ package body Sem_Ch3 is -- build-in-place library function, child unit or not. if (Nkind (Nod) in N_Entity and then Is_Compilation_Unit (Nod)) - or else (Nkind_In (Nod, N_Defining_Program_Unit_Name, - N_Subprogram_Declaration) - and then Is_Compilation_Unit (Defining_Entity (Nod))) + or else (Nkind (Nod) in + N_Defining_Program_Unit_Name | N_Subprogram_Declaration + and then Is_Compilation_Unit (Defining_Entity (Nod))) then Add_Global_Declaration (IR); else @@ -10510,7 +10507,7 @@ package body Sem_Ch3 is Analyze_And_Resolve (Bound, Base_Type (Par_T)); - if Nkind_In (Bound, N_Integer_Literal, N_Real_Literal) then + if Nkind (Bound) in N_Integer_Literal | N_Real_Literal then New_Bound := New_Copy (Bound); Set_Etype (New_Bound, Der_T); Set_Analyzed (New_Bound); @@ -11541,7 +11538,7 @@ package body Sem_Ch3 is begin if not Comes_From_Source (E) then - if Ekind_In (E, E_Task_Type, E_Protected_Type) then + if Ekind (E) in E_Task_Type | E_Protected_Type then -- It may be an anonymous protected type created for a -- single variable. Post error on variable, if present. @@ -11671,10 +11668,10 @@ package body Sem_Ch3 is -- this kind is reserved for predefined operators, that are -- intrinsic and do not need completion. - elsif Ekind_In (E, E_Function, - E_Procedure, - E_Generic_Function, - E_Generic_Procedure) + elsif Ekind (E) in E_Function + | E_Procedure + | E_Generic_Function + | E_Generic_Procedure then if Has_Completion (E) then null; @@ -11733,7 +11730,7 @@ package body Sem_Ch3 is Post_Error; end if; - elsif Ekind_In (E, E_Task_Type, E_Protected_Type) then + elsif Ekind (E) in E_Task_Type | E_Protected_Type then if not Has_Completion (E) then Post_Error; end if; @@ -14615,7 +14612,7 @@ package body Sem_Ch3 is if Is_Tagged_Type (Typ) or else Has_Controlled_Component (Typ) then Old_C := First_Component (Typ); while Present (Old_C) loop - if Nam_In (Chars (Old_C), Name_uTag, Name_uParent) then + if Chars (Old_C) in Name_uTag | Name_uParent then Append_Elmt (Old_C, Comp_List); end if; @@ -15460,9 +15457,9 @@ package body Sem_Ch3 is or else Is_Private_Overriding or else Is_Internal_Name (Chars (Parent_Subp)) or else (Is_Controlled (Parent_Type) - and then Nam_In (Chars (Parent_Subp), Name_Adjust, - Name_Finalize, - Name_Initialize)) + and then Chars (Parent_Subp) in Name_Adjust + | Name_Finalize + | Name_Initialize) then Set_Derived_Name; @@ -15661,9 +15658,9 @@ package body Sem_Ch3 is -- set on both views of the type. if Is_Controlled (Parent_Type) - and then Nam_In (Chars (Parent_Subp), Name_Initialize, - Name_Adjust, - Name_Finalize) + and then Chars (Parent_Subp) in Name_Initialize + | Name_Adjust + | Name_Finalize and then Is_Hidden (Parent_Subp) and then not Is_Visibly_Controlled (Parent_Type) then @@ -16882,7 +16879,7 @@ package body Sem_Ch3 is -- Check for early use of incomplete or private type - if Ekind_In (Parent_Type, E_Void, E_Incomplete_Type) then + if Ekind (Parent_Type) in E_Void | E_Incomplete_Type then Error_Msg_N ("premature derivation of incomplete type", Indic); return; @@ -17419,14 +17416,14 @@ package body Sem_Ch3 is -- Check invalid completion of private or incomplete type - elsif not Nkind_In (N, N_Full_Type_Declaration, - N_Task_Type_Declaration, - N_Protected_Type_Declaration) + elsif Nkind (N) not in N_Full_Type_Declaration + | N_Task_Type_Declaration + | N_Protected_Type_Declaration and then (Ada_Version < Ada_2012 or else not Is_Incomplete_Type (Prev) - or else not Nkind_In (N, N_Private_Type_Declaration, - N_Private_Extension_Declaration)) + or else Nkind (N) not in N_Private_Type_Declaration + | N_Private_Extension_Declaration) then -- Completion must be a full type declarations (RM 7.3(4)) @@ -17503,9 +17500,8 @@ package body Sem_Ch3 is end if; if Nkind (N) = N_Full_Type_Declaration - and then Nkind_In - (Type_Definition (N), N_Record_Definition, - N_Derived_Type_Definition) + and then Nkind (Type_Definition (N)) in + N_Record_Definition | N_Derived_Type_Definition and then Interface_Present (Type_Definition (N)) then Error_Msg_N @@ -17522,15 +17518,15 @@ package body Sem_Ch3 is New_Id := Id; elsif Ekind (Prev) = E_Private_Type - and then Nkind_In (N, N_Task_Type_Declaration, - N_Protected_Type_Declaration) + and then Nkind (N) in N_Task_Type_Declaration + | N_Protected_Type_Declaration then Error_Msg_N ("completion of nonlimited type cannot be limited", N); elsif Ekind (Prev) = E_Record_Type_With_Private - and then Nkind_In (N, N_Task_Type_Declaration, - N_Protected_Type_Declaration) + and then Nkind (N) in N_Task_Type_Declaration + | N_Protected_Type_Declaration then if not Is_Limited_Record (Prev) then Error_Msg_N @@ -17547,8 +17543,8 @@ package body Sem_Ch3 is -- type or a protected type. This case arises when covering -- interface types. - elsif Nkind_In (N, N_Task_Type_Declaration, - N_Protected_Type_Declaration) + elsif Nkind (N) in N_Task_Type_Declaration + | N_Protected_Type_Declaration then null; @@ -17645,8 +17641,8 @@ package body Sem_Ch3 is if Ada_Version >= Ada_2012 and then Is_Incomplete_Type (Prev) - and then Nkind_In (N, N_Private_Type_Declaration, - N_Private_Extension_Declaration) + and then Nkind (N) in N_Private_Type_Declaration + | N_Private_Extension_Declaration then -- No need to check private extensions since they are tagged @@ -17660,8 +17656,8 @@ package body Sem_Ch3 is -- a synchronized type that implements interfaces) or a -- type extension, otherwise this is an error. - elsif Nkind_In (N, N_Task_Type_Declaration, - N_Protected_Type_Declaration) + elsif Nkind (N) in N_Task_Type_Declaration + | N_Protected_Type_Declaration then if No (Interface_List (N)) and then not Error_Posted (N) then Tag_Mismatch; @@ -17729,8 +17725,8 @@ package body Sem_Ch3 is -- Case of an anonymous array subtype - if Nkind_In (Def_Kind, N_Constrained_Array_Definition, - N_Unconstrained_Array_Definition) + if Def_Kind in + N_Constrained_Array_Definition | N_Unconstrained_Array_Definition then T := Empty; Array_Type_Declaration (T, Obj_Def); @@ -18669,8 +18665,7 @@ package body Sem_Ch3 is then null; - elsif Ekind_In (Derived_Base, E_Private_Type, - E_Limited_Private_Type) + elsif Ekind (Derived_Base) in E_Private_Type | E_Limited_Private_Type then null; @@ -18814,16 +18809,13 @@ package body Sem_Ch3 is return Constraint_Kind = N_Range_Constraint; when Decimal_Fixed_Point_Kind => - return Nkind_In (Constraint_Kind, N_Digits_Constraint, - N_Range_Constraint); + return Constraint_Kind in N_Digits_Constraint | N_Range_Constraint; when Ordinary_Fixed_Point_Kind => - return Nkind_In (Constraint_Kind, N_Delta_Constraint, - N_Range_Constraint); + return Constraint_Kind in N_Delta_Constraint | N_Range_Constraint; when Float_Kind => - return Nkind_In (Constraint_Kind, N_Digits_Constraint, - N_Range_Constraint); + return Constraint_Kind in N_Digits_Constraint | N_Range_Constraint; when Access_Kind | Array_Kind @@ -18883,7 +18875,7 @@ package body Sem_Ch3 is -- Start of processing for Is_Visible_Component begin - if Ekind_In (C, E_Component, E_Discriminant) then + if Ekind (C) in E_Component | E_Discriminant then Original_Comp := Original_Record_Component (C); end if; @@ -20709,9 +20701,9 @@ package body Sem_Ch3 is Priv := Node (Priv_Elmt); Priv_Scop := Scope (Priv); - if Ekind_In (Priv, E_Private_Subtype, - E_Limited_Private_Subtype, - E_Record_Subtype_With_Private) + if Ekind (Priv) in E_Private_Subtype + | E_Limited_Private_Subtype + | E_Record_Subtype_With_Private then Full := Make_Defining_Identifier (Sloc (Priv), Chars (Priv)); Set_Is_Itype (Full); @@ -20882,7 +20874,7 @@ package body Sem_Ch3 is Prim := Next_Entity (Full_T); while Present (Prim) and then Prim /= Priv_T loop - if Ekind_In (Prim, E_Procedure, E_Function) then + if Ekind (Prim) in E_Procedure | E_Function then Disp_Typ := Find_Dispatching_Type (Prim); if Disp_Typ = Full_T @@ -21336,17 +21328,16 @@ package body Sem_Ch3 is exit when Nkind (Insert_Node) in N_Declaration and then - not Nkind_In - (Insert_Node, N_Component_Declaration, - N_Loop_Parameter_Specification, - N_Function_Specification, - N_Procedure_Specification); - - exit when Nkind (Insert_Node) in N_Later_Decl_Item - or else Nkind (Insert_Node) in - N_Statement_Other_Than_Procedure_Call - or else Nkind_In (Insert_Node, N_Procedure_Call_Statement, - N_Pragma); + Nkind (Insert_Node) not in N_Component_Declaration + | N_Loop_Parameter_Specification + | N_Function_Specification + | N_Procedure_Specification; + + exit when Nkind (Insert_Node) in + N_Later_Decl_Item | + N_Statement_Other_Than_Procedure_Call | + N_Procedure_Call_Statement | + N_Pragma; Insert_Node := Parent (Insert_Node); end loop; @@ -21560,20 +21551,19 @@ package body Sem_Ch3 is -- The following is ugly, can't we have a range or even a flag??? May_Have_Null_Exclusion := - Nkind_In (P, N_Access_Definition, - N_Access_Function_Definition, - N_Access_Procedure_Definition, - N_Access_To_Object_Definition, - N_Allocator, - N_Component_Definition) - or else - Nkind_In (P, N_Derived_Type_Definition, - N_Discriminant_Specification, - N_Formal_Object_Declaration, - N_Object_Declaration, - N_Object_Renaming_Declaration, - N_Parameter_Specification, - N_Subtype_Declaration); + Nkind (P) in N_Access_Definition + | N_Access_Function_Definition + | N_Access_Procedure_Definition + | N_Access_To_Object_Definition + | N_Allocator + | N_Component_Definition + | N_Derived_Type_Definition + | N_Discriminant_Specification + | N_Formal_Object_Declaration + | N_Object_Declaration + | N_Object_Renaming_Declaration + | N_Parameter_Specification + | N_Subtype_Declaration; -- Create an Itype that is a duplicate of Entity (S) but with the -- null-exclusion attribute. |