diff options
Diffstat (limited to 'gcc/ada/sem_ch6.adb')
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 205 |
1 files changed, 99 insertions, 106 deletions
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index cd108d8..ed1c326 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -760,8 +760,8 @@ package body Sem_Ch6 is elsif Kind = N_Function_Call and then Is_Entity_Name (Name (Return_Expr)) - and then Ekind_In (Entity (Name (Return_Expr)), E_Function, - E_Generic_Function) + and then Ekind (Entity (Name (Return_Expr))) in + E_Function | E_Generic_Function and then No_Return (Entity (Name (Return_Expr))) then return; @@ -801,8 +801,8 @@ package body Sem_Ch6 is -- We are only interested in return statements - if not Nkind_In (Return_Stmt, N_Extended_Return_Statement, - N_Simple_Return_Statement) + if Nkind (Return_Stmt) not in + N_Extended_Return_Statement | N_Simple_Return_Statement then return; end if; @@ -884,8 +884,8 @@ package body Sem_Ch6 is if Nkind (Assoc) = N_Attribute_Reference then Expr := Assoc; - elsif Nkind_In (Assoc, N_Component_Association, - N_Discriminant_Association) + elsif Nkind (Assoc) in + N_Component_Association | N_Discriminant_Association then Expr := Expression (Assoc); else @@ -911,9 +911,9 @@ package body Sem_Ch6 is Obj := Original_Node (Prefix (Expr)); loop - while Nkind_In (Obj, N_Explicit_Dereference, - N_Indexed_Component, - N_Selected_Component) + while Nkind (Obj) in N_Explicit_Dereference + | N_Indexed_Component + | N_Selected_Component loop -- When we encounter a named access type then we can -- ignore accessibility checks on the dereference. @@ -1156,8 +1156,7 @@ package body Sem_Ch6 is -- This early expansion is done only when the return statement is -- not part of a handled sequence of statements. - if Nkind_In (Expr, N_Aggregate, - N_Extension_Aggregate) + if Nkind (Expr) in N_Aggregate | N_Extension_Aggregate and then Needs_Finalization (R_Type) and then Nkind (Parent (N)) /= N_Handled_Sequence_Of_Statements then @@ -1189,7 +1188,7 @@ package body Sem_Ch6 is if Expander_Active and then Serious_Errors_Detected = 0 and then Is_Access_Type (R_Type) - and then not Nkind_In (Expr, N_Null, N_Raise_Expression) + and then Nkind (Expr) not in N_Null | N_Raise_Expression and then Is_Interface (Designated_Type (R_Type)) and then Is_Progenitor (Designated_Type (R_Type), Designated_Type (Etype (Expr))) @@ -1249,7 +1248,7 @@ package body Sem_Ch6 is and then not Is_Constrained (R_Type) and then Is_Build_In_Place_Function (Scope_Id) and then Needs_BIP_Alloc_Form (Scope_Id) - and then Nkind_In (Expr, N_Aggregate, N_Extension_Aggregate) + and then Nkind (Expr) in N_Aggregate | N_Extension_Aggregate then Preanalyze (Obj_Decl); @@ -1996,9 +1995,9 @@ package body Sem_Ch6 is -- Special processing for Elab_Spec, Elab_Body and Elab_Subp_Body calls if Nkind (P) = N_Attribute_Reference - and then Nam_In (Attribute_Name (P), Name_Elab_Spec, - Name_Elab_Body, - Name_Elab_Subp_Body) + and then Attribute_Name (P) in Name_Elab_Spec + | Name_Elab_Body + | Name_Elab_Subp_Body then if Present (Actuals) then Error_Msg_N @@ -2088,9 +2087,8 @@ package body Sem_Ch6 is -- function, the context will select the operation whose type is Void. elsif Nkind (P) = N_Selected_Component - and then Ekind_In (Entity (Selector_Name (P)), E_Entry, - E_Function, - E_Procedure) + and then Ekind (Entity (Selector_Name (P))) + in E_Entry | E_Function | E_Procedure then -- When front-end inlining is enabled, as with SPARK_Mode, a call -- in prefix notation may still be missing its controlling argument, @@ -2189,8 +2187,8 @@ package body Sem_Ch6 is ------------------------------ procedure Analyze_Return_Statement (N : Node_Id) is - pragma Assert (Nkind_In (N, N_Extended_Return_Statement, - N_Simple_Return_Statement)); + pragma Assert + (Nkind (N) in N_Extended_Return_Statement | N_Simple_Return_Statement); Returns_Object : constant Boolean := Nkind (N) = N_Extended_Return_Statement @@ -2223,7 +2221,7 @@ package body Sem_Ch6 is for J in reverse 0 .. Scope_Stack.Last loop Result := Scope_Stack.Table (J).Entity; - exit when not Ekind_In (Result, E_Block, E_Loop) + exit when Ekind (Result) not in E_Block | E_Loop and then Chars (Result) /= Name_uPostconditions; end loop; @@ -2259,7 +2257,7 @@ package body Sem_Ch6 is -- implicitly-generated return that is placed at the end. if No_Return (Scope_Id) - and then Ekind_In (Kind, E_Procedure, E_Generic_Procedure) + and then Kind in E_Procedure | E_Generic_Procedure and then Comes_From_Source (N) then Error_Msg_N @@ -2274,17 +2272,17 @@ package body Sem_Ch6 is -- Check that functions return objects, and other things do not - if Ekind_In (Kind, E_Function, E_Generic_Function) then + if Kind in E_Function | E_Generic_Function then if not Returns_Object then Error_Msg_N ("missing expression in return from function", N); end if; - elsif Ekind_In (Kind, E_Procedure, E_Generic_Procedure) then + elsif Kind in E_Procedure | E_Generic_Procedure then if Returns_Object then Error_Msg_N ("procedure cannot return value (use function)", N); end if; - elsif Ekind_In (Kind, E_Entry, E_Entry_Family) then + elsif Kind in E_Entry | E_Entry_Family then if Returns_Object then if Is_Protected_Type (Scope (Scope_Id)) then Error_Msg_N ("entry body cannot return value", N); @@ -2318,10 +2316,10 @@ package body Sem_Ch6 is Error_Msg_N ("illegal context for return statement", N); end if; - if Ekind_In (Kind, E_Function, E_Generic_Function) then + if Kind in E_Function | E_Generic_Function then Analyze_Function_Return (N); - elsif Ekind_In (Kind, E_Procedure, E_Generic_Procedure) then + elsif Kind in E_Procedure | E_Generic_Procedure then Set_Return_Present (Scope_Id); end if; @@ -2486,8 +2484,8 @@ package body Sem_Ch6 is null; elsif Nkind (Parent (N)) = N_Subprogram_Body - or else Nkind_In (Parent (Parent (N)), N_Accept_Statement, - N_Entry_Body) + or else Nkind (Parent (Parent (N))) in + N_Accept_Statement | N_Entry_Body then Error_Msg_NE ("invalid use of untagged incomplete type&", @@ -3061,8 +3059,8 @@ package body Sem_Ch6 is -- the environment task is our effective master, so nothing -- to mark. - if Nkind_In - (Par, N_Task_Body, N_Block_Statement, N_Subprogram_Body) + if Nkind (Par) + in N_Task_Body | N_Block_Statement | N_Subprogram_Body then Set_Is_Task_Master (Par, True); exit; @@ -3415,7 +3413,7 @@ package body Sem_Ch6 is -- Do not process subprogram bodies as they already use the non- -- limited view of types. - if not Ekind_In (Subp_Id, E_Function, E_Procedure) then + if Ekind (Subp_Id) not in E_Function | E_Procedure then return No_Elist; end if; @@ -3518,11 +3516,11 @@ package body Sem_Ch6 is if Is_Entity_Name (Node) and then Present (Entity (Node)) then Mask_Type (Etype (Entity (Node))); - if Ekind_In (Entity (Node), E_Component, E_Discriminant) then + if Ekind (Entity (Node)) in E_Component | E_Discriminant then Mask_Type (Scope (Entity (Node))); end if; - elsif Nkind_In (Node, N_Aggregate, N_Null, N_Type_Conversion) + elsif Nkind (Node) in N_Aggregate | N_Null | N_Type_Conversion and then Present (Etype (Node)) then Mask_Type (Etype (Node)); @@ -3585,19 +3583,18 @@ package body Sem_Ch6 is -- Move relevant pragmas to the spec - elsif Nam_In (Pragma_Name_Unmapped (Decl), - Name_Depends, - Name_Ghost, - Name_Global, - Name_Pre, - Name_Precondition, - Name_Post, - Name_Refined_Depends, - Name_Refined_Global, - Name_Refined_Post, - Name_Inline, - Name_Pure_Function, - Name_Volatile_Function) + elsif Pragma_Name_Unmapped (Decl) in Name_Depends + | Name_Ghost + | Name_Global + | Name_Pre + | Name_Precondition + | Name_Post + | Name_Refined_Depends + | Name_Refined_Global + | Name_Refined_Post + | Name_Inline + | Name_Pure_Function + | Name_Volatile_Function then Remove (Decl); Insert_After (Insert_Nod, Decl); @@ -3693,9 +3690,9 @@ package body Sem_Ch6 is -- expansion. As a result, we add an exception for this case. elsif not Present (Overridden_Operation (Spec_Id)) - and then not (Nam_In (Chars (Spec_Id), Name_Adjust, - Name_Finalize, - Name_Initialize) + and then not (Chars (Spec_Id) in Name_Adjust + | Name_Finalize + | Name_Initialize and then In_Instance) then Error_Msg_NE @@ -4995,9 +4992,7 @@ package body Sem_Ch6 is -- Push_xxx_Error_Label to find the first real statement. Stm := First (Statements (HSS)); - while Nkind_In (Stm, N_Call_Marker, N_Label) - or else Nkind (Stm) in N_Push_xxx_Label - loop + while Nkind (Stm) in N_Call_Marker | N_Label | N_Push_xxx_Label loop Next (Stm); end loop; @@ -5553,10 +5548,10 @@ package body Sem_Ch6 is -- In case of primitives associated with abstract interface types -- the check is applied later (see Analyze_Subprogram_Declaration). - if not Nkind_In (Original_Node (Parent (N)), - N_Abstract_Subprogram_Declaration, - N_Formal_Abstract_Subprogram_Declaration, - N_Subprogram_Renaming_Declaration) + if Nkind (Original_Node (Parent (N))) not in + N_Abstract_Subprogram_Declaration | + N_Formal_Abstract_Subprogram_Declaration | + N_Subprogram_Renaming_Declaration then if Is_Abstract_Type (Etype (Designator)) then Error_Msg_N @@ -5685,11 +5680,11 @@ package body Sem_Ch6 is -- the only way these may receive a convention is if they inherit -- the convention of a related subprogram. - if Ekind_In (Id1, E_Anonymous_Access_Subprogram_Type, - E_Subprogram_Type) + if Ekind (Id1) in E_Anonymous_Access_Subprogram_Type + | E_Subprogram_Type or else - Ekind_In (Id2, E_Anonymous_Access_Subprogram_Type, - E_Subprogram_Type) + Ekind (Id2) in E_Anonymous_Access_Subprogram_Type + | E_Subprogram_Type then return True; @@ -5997,7 +5992,7 @@ package body Sem_Ch6 is if Ctype >= Mode_Conformant then if Parameter_Mode (Old_Formal) /= Parameter_Mode (New_Formal) then - if not Ekind_In (New_Id, E_Function, E_Procedure) + if Ekind (New_Id) not in E_Function | E_Procedure or else not Is_Primitive_Wrapper (New_Id) then Conformance_Error ("\mode of & does not match!", New_Formal); @@ -6766,11 +6761,11 @@ package body Sem_Ch6 is Decl := Unit_Declaration_Node (Subp); end if; - if Nkind_In (Decl, N_Subprogram_Body, - N_Subprogram_Body_Stub, - N_Subprogram_Declaration, - N_Abstract_Subprogram_Declaration, - N_Subprogram_Renaming_Declaration) + if Nkind (Decl) in N_Subprogram_Body + | N_Subprogram_Body_Stub + | N_Subprogram_Declaration + | N_Abstract_Subprogram_Declaration + | N_Subprogram_Renaming_Declaration then Spec := Specification (Decl); @@ -6866,9 +6861,9 @@ package body Sem_Ch6 is if Present (Overridden_Subp) and then (not Is_Hidden (Overridden_Subp) or else - (Nam_In (Chars (Overridden_Subp), Name_Initialize, - Name_Adjust, - Name_Finalize) + (Chars (Overridden_Subp) in Name_Initialize + | Name_Adjust + | Name_Finalize and then Present (Alias (Overridden_Subp)) and then (not Is_Hidden (Alias (Overridden_Subp)) or else In_Instance))) @@ -7170,12 +7165,10 @@ package body Sem_Ch6 is -- Don't count exception junk or else - (Nkind_In (Last_Stm, N_Goto_Statement, - N_Label, - N_Object_Declaration) + (Nkind (Last_Stm) in + N_Goto_Statement | N_Label | N_Object_Declaration and then Exception_Junk (Last_Stm)) - or else Nkind (Last_Stm) in N_Push_xxx_Label - or else Nkind (Last_Stm) in N_Pop_xxx_Label + or else Nkind (Last_Stm) in N_Push_xxx_Label | N_Pop_xxx_Label -- Inserted code, such as finalization calls, is irrelevant: we only -- need to check original source. @@ -7603,7 +7596,7 @@ package body Sem_Ch6 is function Is_Valid_Formal (F : Entity_Id) return Boolean is begin return - Ekind_In (F, E_In_Out_Parameter, E_Out_Parameter) + Ekind (F) in E_In_Out_Parameter | E_Out_Parameter or else (Nkind (Parameter_Type (Parent (F))) = N_Access_Definition and then not Constant_Present (Parameter_Type (Parent (F)))); @@ -7840,7 +7833,7 @@ package body Sem_Ch6 is -- Entries and procedures can override abstract or null interface -- procedures. - elsif Ekind_In (Def_Id, E_Entry, E_Procedure) + elsif Ekind (Def_Id) in E_Entry | E_Procedure and then Ekind (Subp) = E_Procedure and then Matches_Prefixed_View_Profile (Parameter_Specifications (Parent (Def_Id)), @@ -7860,7 +7853,7 @@ package body Sem_Ch6 is -- override, the first parameter of the overridden routine -- must be of mode "out", "in out", or access-to-variable. - if Ekind_In (Candidate, E_Entry, E_Procedure) + if Ekind (Candidate) in E_Entry | E_Procedure and then Is_Protected_Type (Typ) and then not Is_Valid_Formal (Formal) then @@ -8266,11 +8259,11 @@ package body Sem_Ch6 is -- or both could be access to protected subprograms. Are_Anonymous_Access_To_Subprogram_Types := - Ekind_In (Type_1, E_Anonymous_Access_Subprogram_Type, - E_Anonymous_Access_Protected_Subprogram_Type) + Ekind (Type_1) in E_Anonymous_Access_Subprogram_Type + | E_Anonymous_Access_Protected_Subprogram_Type and then - Ekind_In (Type_2, E_Anonymous_Access_Subprogram_Type, - E_Anonymous_Access_Protected_Subprogram_Type); + Ekind (Type_2) in E_Anonymous_Access_Subprogram_Type + | E_Anonymous_Access_Protected_Subprogram_Type; -- Test anonymous access type case. For this case, static subtype -- matching is required for mode conformance (RM 6.3.1(15)). We check @@ -8732,8 +8725,8 @@ package body Sem_Ch6 is -- to this are inherited operations from a parent type in which -- case the derived type acts as their parent. - if Nkind_In (Subp_Decl, N_Function_Specification, - N_Procedure_Specification) + if Nkind (Subp_Decl) in N_Function_Specification + | N_Procedure_Specification then Subp_Decl := Parent (Subp_Decl); end if; @@ -9259,8 +9252,8 @@ package body Sem_Ch6 is -- conformant with it. That can occur in cases where an -- actual type causes unrelated homographs in the instance. - if Nkind_In (N, N_Subprogram_Body, - N_Subprogram_Renaming_Declaration) + if Nkind (N) in N_Subprogram_Body + | N_Subprogram_Renaming_Declaration and then Present (Homonym (E)) and then not Fully_Conformant (Designator, E) then @@ -9535,9 +9528,10 @@ package body Sem_Ch6 is function User_Defined_Numeric_Literal_Mismatch return Boolean is E1_Is_User_Defined : constant Boolean := - not Nkind_In (Given_E1, N_Integer_Literal, N_Real_Literal); + Nkind (Given_E1) not in N_Integer_Literal | N_Real_Literal; E2_Is_User_Defined : constant Boolean := - not Nkind_In (Given_E2, N_Integer_Literal, N_Real_Literal); + Nkind (Given_E2) not in N_Integer_Literal | N_Real_Literal; + begin pragma Assert (E1_Is_User_Defined = E2_Is_User_Defined); @@ -10712,10 +10706,9 @@ package body Sem_Ch6 is H := Homonym (H); exit when not Present (H) or else Scope (H) /= Scope (S); - if Nkind_In - (Parent (H), - N_Private_Extension_Declaration, - N_Private_Type_Declaration) + if Nkind (Parent (H)) in + N_Private_Extension_Declaration | + N_Private_Type_Declaration and then Defining_Identifier (Parent (H)) = Partial_View then return True; @@ -12017,9 +12010,9 @@ package body Sem_Ch6 is and then not Is_Generic_Type (Formal_Type) and then not Is_Class_Wide_Type (Formal_Type) then - if not Nkind_In - (Parent (T), N_Access_Function_Definition, - N_Access_Procedure_Definition) + if Nkind (Parent (T)) not in + N_Access_Function_Definition | + N_Access_Procedure_Definition then Append_Elmt (Current_Scope, Private_Dependents (Base_Type (Formal_Type))); @@ -12036,8 +12029,8 @@ package body Sem_Ch6 is end if; end if; - elsif not Nkind_In (Parent (T), N_Access_Function_Definition, - N_Access_Procedure_Definition) + elsif Nkind (Parent (T)) not in N_Access_Function_Definition + | N_Access_Procedure_Definition then -- AI05-0151: Tagged incomplete types are allowed in all -- formal parts. Untagged incomplete types are not allowed @@ -12064,9 +12057,9 @@ package body Sem_Ch6 is then null; - elsif Nkind_In (Context, N_Accept_Statement, - N_Accept_Alternative, - N_Entry_Body) + elsif Nkind (Context) in N_Accept_Statement + | N_Accept_Alternative + | N_Entry_Body or else (Nkind (Context) = N_Subprogram_Body and then Comes_From_Source (Context)) then @@ -12244,12 +12237,12 @@ package body Sem_Ch6 is -- these are not standard Ada legality rules. if SPARK_Mode = On then - if Ekind_In (Scope (Formal), E_Function, E_Generic_Function) then + if Ekind (Scope (Formal)) in E_Function | E_Generic_Function then -- A function cannot have a parameter of mode IN OUT or OUT -- (SPARK RM 6.1). - if Ekind_In (Formal, E_In_Out_Parameter, E_Out_Parameter) then + if Ekind (Formal) in E_In_Out_Parameter | E_Out_Parameter then Error_Msg_N ("function cannot have parameter of mode `OUT` or " & "`IN OUT`", Formal); @@ -12572,7 +12565,7 @@ package body Sem_Ch6 is Set_Has_Out_Or_In_Out_Parameter (Id, True); end if; - if Ekind_In (Id, E_Function, E_Generic_Function) then + if Ekind (Id) in E_Function | E_Generic_Function then -- [IN] OUT parameters allowed for functions in Ada 2012 @@ -12754,12 +12747,12 @@ package body Sem_Ch6 is -- Verify that user-defined operators have proper number of arguments -- First case of operators which can only be unary - if Nam_In (Id, Name_Op_Not, Name_Op_Abs) then + if Id in Name_Op_Not | Name_Op_Abs then N_OK := (N = 1); -- Case of operators which can be unary or binary - elsif Nam_In (Id, Name_Op_Add, Name_Op_Subtract) then + elsif Id in Name_Op_Add | Name_Op_Subtract then N_OK := (N in 1 .. 2); -- All other operators can only be binary |