diff options
41 files changed, 302 insertions, 406 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 60e39f5eca5..6bd9853aafd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,21 @@ 2013-04-12 Robert Dewar <dewar@adacore.com> + * namet.adb, namet.ads: Minor addition (7 arg version of Nam_In). + * exp_prag.adb, sem_ch3.adb, sem_intr.adb, sem_type.adb, exp_util.adb, + sem_aux.adb, exp_ch9.adb, sem_ch7.adb, sem_ch10.adb, sem_prag.adb, + par-ch2.adb, tbuild.adb, rtsfind.adb, freeze.adb, sem_util.adb, + sem_res.adb, sem_attr.adb, exp_ch2.adb, prj-makr.adb, sem_elab.adb, + exp_ch4.adb, sem_ch4.adb, sem_mech.adb, sem_ch6.adb, par-prag.adb, + prj-nmsc.adb, exp_disp.adb, sem_ch8.adb, sem_warn.adb, par-util.adb, + sem_eval.adb, exp_intr.adb, sem_ch13.adb, exp_cg.adb, lib-xref.adb, + sem_disp.adb, exp_ch3.adb: Minor code reorganization (use Nam_In). + +2013-04-12 Doug Rupp <rupp@adacore.com> + + * init.c: Don't clobber condition code on VMS. + +2013-04-12 Robert Dewar <dewar@adacore.com> + * exp_aggr.adb: Minor reformatting. * namet.ads, namet.adb (Nam_In): New functions. diff --git a/gcc/ada/exp_cg.adb b/gcc/ada/exp_cg.adb index 076783f7113..d8a7022e504 100644 --- a/gcc/ada/exp_cg.adb +++ b/gcc/ada/exp_cg.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2010-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 2010-2013, 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- -- @@ -261,12 +261,10 @@ package body Exp_CG is return True; elsif not Has_Fully_Qualified_Name (E) then - if Chars (E) = Name_uSize - or else Chars (E) = Name_uAlignment + if Nam_In (Chars (E), Name_uSize, Name_uAlignment, Name_uAssign) or else (Chars (E) = Name_Op_Eq - and then Etype (First_Formal (E)) = Etype (Last_Formal (E))) - or else Chars (E) = Name_uAssign + and then Etype (First_Formal (E)) = Etype (Last_Formal (E))) or else Is_Predefined_Interface_Primitive (E) then return True; diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb index b93f832441c..af35113b7b9 100644 --- a/gcc/ada/exp_ch2.adb +++ b/gcc/ada/exp_ch2.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -162,12 +162,11 @@ package body Exp_Ch2 is -- lvalue references in the arguments. and then not (Nkind (Parent (N)) = N_Attribute_Reference - and then - (Attribute_Name (Parent (N)) = Name_Asm_Input - or else - Attribute_Name (Parent (N)) = Name_Asm_Output - or else - Prefix (Parent (N)) = N)) + and then + (Nam_In (Attribute_Name (Parent (N)), + Name_Asm_Input, + Name_Asm_Output) + or else Prefix (Parent (N)) = N)) then -- Case of Current_Value is a compile time known value diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index e16adfb56ca..a0b08ed937c 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1829,9 +1829,8 @@ package body Exp_Ch3 is -- traversing the expression. ??? if Kind = N_Attribute_Reference - and then (Attribute_Name (N) = Name_Unchecked_Access - or else - Attribute_Name (N) = Name_Unrestricted_Access) + and then Nam_In (Attribute_Name (N), Name_Unchecked_Access, + Name_Unrestricted_Access) and then Is_Entity_Name (Prefix (N)) and then Is_Type (Entity (Prefix (N))) and then Entity (Prefix (N)) = Rec_Type @@ -2833,9 +2832,9 @@ package body Exp_Ch3 is elsif Ekind (Scope (Id)) = E_Record_Type and then Present (Corresponding_Concurrent_Type (Scope (Id))) - and then (Chars (Id) = Name_uCPU or else - Chars (Id) = Name_uDispatching_Domain or else - Chars (Id) = Name_uPriority) + and then Nam_In (Chars (Id), Name_uCPU, + Name_uDispatching_Domain, + Name_uPriority) then declare Exp : Node_Id; @@ -4182,7 +4181,7 @@ package body Exp_Ch3 is Eq_Op := Empty; while Present (Prim) loop if Chars (Node (Prim)) = Name_Op_Eq - and then Comes_From_Source (Node (Prim)) + and then Comes_From_Source (Node (Prim)) -- Don't we also need to check formal types and return type as in -- User_Defined_Eq above??? diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 7eca831d277..31c689e232b 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -6485,11 +6485,9 @@ package body Exp_Ch4 is return; elsif Nkind (Parnt) = N_Attribute_Reference - and then (Attribute_Name (Parnt) = Name_Address - or else - Attribute_Name (Parnt) = Name_Bit - or else - Attribute_Name (Parnt) = Name_Size) + and then Nam_In (Attribute_Name (Parnt), Name_Address, + Name_Bit, + Name_Size) and then Prefix (Parnt) = Child then return; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 6d35eb1d56f..69eaafff1ed 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -1933,9 +1933,8 @@ package body Exp_Ch9 is -- Transfer ppc pragmas to the declarations of the wrapper while Present (P) loop - if Pragma_Name (P) = Name_Precondition - or else - Pragma_Name (P) = Name_Postcondition + if Nam_In (Pragma_Name (P), Name_Precondition, + Name_Postcondition) then Append (Relocate_Node (P), Decls); Set_Analyzed (Last (Decls), False); @@ -14087,11 +14086,10 @@ package body Exp_Ch9 is and then (Nkind_In (Stmt, N_Null_Statement, N_Label) or else (Nkind (Stmt) = N_Pragma - and then (Pragma_Name (Stmt) = Name_Unreferenced - or else - Pragma_Name (Stmt) = Name_Unmodified - or else - Pragma_Name (Stmt) = Name_Warnings))) + and then + Nam_In (Pragma_Name (Stmt), Name_Unreferenced, + Name_Unmodified, + Name_Warnings))) loop Next (Stmt); end loop; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index b003d854dbd..7490e9df7bf 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -2106,11 +2106,10 @@ package body Exp_Disp is TSS_Name_Type (Name_Buffer (Name_Len - TSS_Name'Length + 1 .. Name_Len)); - if Chars (E) = Name_uSize + if Nam_In (Chars (E), Name_uSize, Name_uAssign) or else (Chars (E) = Name_Op_Eq - and then Etype (First_Formal (E)) = Etype (Last_Formal (E))) - or else Chars (E) = Name_uAssign + and then Etype (First_Formal (E)) = Etype (Last_Formal (E))) or else TSS_Name = TSS_Deep_Adjust or else TSS_Name = TSS_Deep_Finalize or else Is_Predefined_Interface_Primitive (E) diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 2d0d817fc8a..7302f077012 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -518,11 +518,9 @@ package body Exp_Intr is elsif Nam = Name_Generic_Dispatching_Constructor then Expand_Dispatching_Constructor_Call (N); - elsif Nam = Name_Import_Address - or else - Nam = Name_Import_Largest_Value - or else - Nam = Name_Import_Value + elsif Nam_In (Nam, Name_Import_Address, + Name_Import_Largest_Value, + Name_Import_Value) then Expand_Import_Call (N); @@ -556,10 +554,10 @@ package body Exp_Intr is elsif Nam = Name_To_Pointer then Expand_To_Pointer (N); - elsif Nam = Name_File - or else Nam = Name_Line - or else Nam = Name_Source_Location - or else Nam = Name_Enclosing_Entity + elsif Nam_In (Nam, Name_File, + Name_Line, + Name_Source_Location, + Name_Enclosing_Entity) then Expand_Source_Info (N, Nam); diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb index 2ae1b561907..ae59ae1d35c 100644 --- a/gcc/ada/exp_prag.adb +++ b/gcc/ada/exp_prag.adb @@ -392,10 +392,7 @@ package body Exp_Prag is -- that the failure is not at the point of occurrence of the -- pragma, unlike the other Check cases. - elsif Nam = Name_Precondition - or else - Nam = Name_Postcondition - then + elsif Nam_In (Nam, Name_Precondition, Name_Postcondition) then Get_Name_String (Nam); Insert_Str_In_Name_Buffer ("failed ", 1); Add_Str_To_Name_Buffer (" from "); diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 190d76e1d7a..38114c1f408 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -5189,11 +5189,9 @@ package body Exp_Util is -- True if access attribute elsif Nkind (N) = N_Attribute_Reference - and then (Attribute_Name (N) = Name_Access - or else - Attribute_Name (N) = Name_Unchecked_Access - or else - Attribute_Name (N) = Name_Unrestricted_Access) + and then Nam_In (Attribute_Name (N), Name_Access, + Name_Unchecked_Access, + Name_Unrestricted_Access) then return True; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 6731022c3f5..87bc2c0b0c1 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -249,12 +249,13 @@ package body Freeze is -- has an interface name, or if it is one of the shift/rotate -- operations known to the compiler. - and then (Present (Interface_Name (Renamed_Subp)) - or else Chars (Renamed_Subp) = Name_Rotate_Left - or else Chars (Renamed_Subp) = Name_Rotate_Right - or else Chars (Renamed_Subp) = Name_Shift_Left - or else Chars (Renamed_Subp) = Name_Shift_Right - or else Chars (Renamed_Subp) = Name_Shift_Right_Arithmetic) + and then + (Present (Interface_Name (Renamed_Subp)) + or else Nam_In (Chars (Renamed_Subp), Name_Rotate_Left, + Name_Rotate_Right, + Name_Shift_Left, + Name_Shift_Right, + Name_Shift_Right_Arithmetic)) then Set_Interface_Name (Ent, Interface_Name (Renamed_Subp)); @@ -1834,9 +1835,8 @@ package body Freeze is begin case Nkind (N) is when N_Attribute_Reference => - if (Attribute_Name (N) = Name_Access - or else - Attribute_Name (N) = Name_Unchecked_Access) + if Nam_In (Attribute_Name (N), Name_Access, + Name_Unchecked_Access) and then Is_Entity_Name (Prefix (N)) and then Is_Type (Entity (Prefix (N))) and then Entity (Prefix (N)) = E @@ -4550,9 +4550,9 @@ package body Freeze is begin pragma Assert - (Op_Name = Name_Allocate - or else Op_Name = Name_Deallocate - or else Op_Name = Name_Storage_Size); + (Nam_In (Op_Name, Name_Allocate, + Name_Deallocate, + Name_Storage_Size)); Error_Msg_Name_1 := Op_Name; @@ -4601,7 +4601,8 @@ package body Freeze is if Op_Name = Name_Allocate then Validate_Simple_Pool_Op_Formal (Op, Formal, E_Out_Parameter, - Address_Type, "Storage_Address", Is_OK); + Address_Type, "Storage_Address", Is_OK); + elsif Op_Name = Name_Deallocate then Validate_Simple_Pool_Op_Formal (Op, Formal, E_In_Parameter, diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 8473ff03ff2..d5057c8ea3d 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -906,6 +906,10 @@ extern Exception_Code Base_Code_In (Exception_Code); /* DEC Ada exceptions are not defined in a header file, so they must be declared. */ +#define FAC_MASK 0x0fff0000 +#define MSG_MASK 0x0000fff8 +#define DECADA_M_FACILITY 0x00310000 + #define ADA$_ALREADY_OPEN 0x0031a594 #define ADA$_CONSTRAINT_ERRO 0x00318324 #define ADA$_DATA_ERROR 0x003192c4 @@ -1060,7 +1064,7 @@ __gnat_default_resignal_p (int code) int i, iexcept; for (i = 0; facility_resignal_table [i]; i++) - if ((code & 0xfff0000) == facility_resignal_table [i]) + if ((code & FAC_MASK) == facility_resignal_table [i]) return 1; for (i = 0, iexcept = 0; @@ -1231,7 +1235,14 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs) message[0] = 0; /* Subtract PC & PSL fields as per ABI for SYS$PUTMSG. */ sigargs[0] -= 2; - SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message); + + /* If it was a DEC Ada specific condtiion, make it GNAT otherwise + keep the old facility. */ + if (sigargs [1] & FAC_MASK == DECADA_M_FACILITY) + SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message); + else + SYS$PUTMSG (sigargs, copy_msg, 0, message); + /* Add back PC & PSL fields as per ABI for SYS$PUTMSG. */ sigargs[0] += 2; msg = message; diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 28ae480338d..ba9221b2bd4 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -516,11 +516,9 @@ package body Lib.Xref is P := Parent (P); if Nkind (P) = N_Pragma then - if Pragma_Name (P) = Name_Warnings - or else - Pragma_Name (P) = Name_Unmodified - or else - Pragma_Name (P) = Name_Unreferenced + if Nam_In (Pragma_Name (P), Name_Warnings, + Name_Unmodified, + Name_Unreferenced) then return False; end if; diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index c4ffa4b592d..1cebb464b8e 100644 --- a/gcc/ada/namet.adb +++ b/gcc/ada/namet.adb @@ -1113,6 +1113,26 @@ package body Namet is T = V6; end Nam_In; + function Nam_In + (T : Name_Id; + V1 : Name_Id; + V2 : Name_Id; + V3 : Name_Id; + V4 : Name_Id; + V5 : Name_Id; + V6 : Name_Id; + V7 : Name_Id) return Boolean + is + begin + return T = V1 or else + T = V2 or else + T = V3 or else + T = V4 or else + T = V5 or else + T = V6 or else + T = V7; + end Nam_In; + ------------------ -- Reinitialize -- ------------------ diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index facb1822dec..dcce9ea91c9 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -211,6 +211,16 @@ package Namet is V5 : Name_Id; V6 : Name_Id) return Boolean; + function Nam_In + (T : Name_Id; + V1 : Name_Id; + V2 : Name_Id; + V3 : Name_Id; + V4 : Name_Id; + V5 : Name_Id; + V6 : Name_Id; + V7 : Name_Id) return Boolean; + pragma Inline (Nam_In); -- Inline all above functions diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb index 37fe454c792..e8d6a9cd227 100644 --- a/gcc/ada/par-ch2.adb +++ b/gcc/ada/par-ch2.adb @@ -433,9 +433,7 @@ package body Ch2 is P := P_Pragma; if Nkind (P) /= N_Error - and then (Pragma_Name (P) = Name_Assert - or else - Pragma_Name (P) = Name_Debug) + and then Nam_In (Pragma_Name (P), Name_Assert, Name_Debug) then Error_Msg_Name_1 := Pragma_Name (P); Error_Msg_N diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index be463778a7d..214a150f82b 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -155,9 +155,7 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is begin if Nkind (Expression (Arg)) /= N_Identifier - or else (Chars (Argx) /= Name_On - and then - Chars (Argx) /= Name_Off) + or else not Nam_In (Chars (Argx), Name_On, Name_Off) then Error_Msg_Name_2 := Name_On; Error_Msg_Name_3 := Name_Off; diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb index 3b59287b703..f2ac335e08c 100644 --- a/gcc/ada/par-util.adb +++ b/gcc/ada/par-util.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -181,8 +181,7 @@ package body Util is if Ada_Version = Ada_95 and then Warn_On_Ada_2005_Compatibility then - if Token_Name = Name_Overriding - or else Token_Name = Name_Synchronized + if Nam_In (Token_Name, Name_Overriding, Name_Synchronized) or else (Token_Name = Name_Interface and then Prev_Token /= Tok_Pragma) then diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index 9572d6882ca..de55a74802c 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -954,10 +954,10 @@ package body Prj.Makr is then Name := Prj.Tree.Name_Of (Current_Node, Tree); - if Name = Name_Source_Files or else - Name = Name_Source_List_File or else - Name = Name_Source_Dirs or else - Name = Name_Naming + if Nam_In (Name, Name_Source_Files, + Name_Source_List_File, + Name_Source_Dirs, + Name_Naming) then Comments := Tree.Project_Nodes.Table (Current_Node).Comments; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index b956292a6e6..758cd529280 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2013, 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- -- @@ -5022,9 +5022,8 @@ package body Prj.Nmsc is function Is_Reserved (Name : Name_Id) return Boolean is begin if Get_Name_Table_Byte (Name) /= 0 - and then Name /= Name_Project - and then Name /= Name_Extends - and then Name /= Name_External + and then + not Nam_In (Name, Name_Project, Name_Extends, Name_External) and then Name not in Ada_2005_Reserved_Words then Unit := No_Name; @@ -7729,7 +7728,7 @@ package body Prj.Nmsc is if Language.First_Source = No_Source and then (Data.Flags.Require_Sources_Other_Lang - or else Language.Name = Name_Ada) + or else Language.Name = Name_Ada) then Iter := For_Each_Source (In_Tree => Data.Tree, Project => Project.Project); diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index 5327da54aac..382d2d1b015 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -537,15 +537,11 @@ package body Rtsfind is return Nkind (Prf) = N_Identifier and then - (Chars (Prf) = Name_Text_IO - or else - Chars (Prf) = Name_Wide_Text_IO - or else - Chars (Prf) = Name_Wide_Wide_Text_IO) - and then - Nkind (Sel) = N_Identifier - and then - Chars (Sel) in Text_IO_Package_Name; + Nam_In (Chars (Prf), Name_Text_IO, + Name_Wide_Text_IO, + Name_Wide_Wide_Text_IO) + and then Nkind (Sel) = N_Identifier + and then Chars (Sel) in Text_IO_Package_Name; end Is_Text_IO_Kludge_Unit; --------------- diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 808ec968c93..42615c1c091 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1225,11 +1225,9 @@ package body Sem_Attr is -- the prefix of another attribute. Error is posted on parent. if Nkind (Parent (N)) = N_Attribute_Reference - and then (Attribute_Name (Parent (N)) = Name_Address - or else - Attribute_Name (Parent (N)) = Name_Code_Address - or else - Attribute_Name (Parent (N)) = Name_Access) + and then Nam_In (Attribute_Name (Parent (N)), Name_Address, + Name_Code_Address, + Name_Access) then Error_Msg_Name_1 := Attribute_Name (Parent (N)); Error_Msg_N ("illegal prefix for % attribute", Parent (N)); @@ -2204,9 +2202,7 @@ package body Sem_Attr is -- a context check if Ada_Version >= Ada_2005 - and then (Aname = Name_Count - or else Aname = Name_Caller - or else Aname = Name_AST_Entry) + and then Nam_In (Aname, Name_Count, Name_Caller, Name_AST_Entry) then declare Count : Natural := 0; @@ -2845,9 +2841,7 @@ package body Sem_Attr is Check_E0; if Nkind (P) = N_Attribute_Reference - and then (Attribute_Name (P) = Name_Elab_Body - or else - Attribute_Name (P) = Name_Elab_Spec) + and then Nam_In (Attribute_Name (P), Name_Elab_Body, Name_Elab_Spec) then null; @@ -3818,11 +3812,10 @@ package body Sem_Attr is if Nkind (Original_Node (Stmt)) = N_Pragma and then - (Pragma_Name (Original_Node (Stmt)) = Name_Assert - or else - Pragma_Name (Original_Node (Stmt)) = Name_Loop_Invariant - or else - Pragma_Name (Original_Node (Stmt)) = Name_Loop_Variant) + Nam_In (Pragma_Name (Original_Node (Stmt)), + Name_Assert, + Name_Loop_Invariant, + Name_Loop_Variant) then In_Loop_Assertion := True; diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 490048e9a7c..556156af08e 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -467,8 +467,8 @@ package body Sem_Aux is elsif Nkind (N) = N_Attribute_Definition_Clause and then (Chars (N) = Nam - or else (Nam = Name_Priority - and then Chars (N) = Name_Interrupt_Priority)) + or else (Nam = Name_Priority + and then Chars (N) = Name_Interrupt_Priority)) then if Check_Parents or else Entity (N) = E then return N; @@ -477,9 +477,9 @@ package body Sem_Aux is elsif Nkind (N) = N_Aspect_Specification and then (Chars (Identifier (N)) = Nam - or else (Nam = Name_Priority - and then Chars (Identifier (N)) = - Name_Interrupt_Priority)) + or else + (Nam = Name_Priority + and then Chars (Identifier (N)) = Name_Interrupt_Priority)) then if Check_Parents then return N; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index f9da78add6d..98b0d5795ae 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -401,9 +401,8 @@ package body Sem_Ch10 is elsif Nkind (Cont_Item) = N_Pragma and then - (Pragma_Name (Cont_Item) = Name_Elaborate - or else - Pragma_Name (Cont_Item) = Name_Elaborate_All) + Nam_In (Pragma_Name (Cont_Item), Name_Elaborate, + Name_Elaborate_All) and then not Used_Type_Or_Elab then Prag_Unit := @@ -2493,9 +2492,9 @@ package body Sem_Ch10 is if Nkind (Nam) = N_Selected_Component and then Nkind (Prefix (Nam)) = N_Identifier and then Chars (Prefix (Nam)) = Name_Gnat - and then (Chars (Selector_Name (Nam)) = Name_Most_Recent_Exception - or else - Chars (Selector_Name (Nam)) = Name_Exception_Traces) + and then Nam_In (Chars (Selector_Name (Nam)), + Name_Most_Recent_Exception, + Name_Exception_Traces) then Check_Restriction (No_Exception_Propagation, N); Special_Exception_Package_Used := True; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index aa633f574ff..32f1f6d76ac 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1001,8 +1001,8 @@ package body Sem_Ch13 is begin A := First (L); while Present (A) loop - exit when Chars (Identifier (A)) = Name_Export - or else Chars (Identifier (A)) = Name_Import; + exit when Nam_In (Chars (Identifier (A)), Name_Export, + Name_Import); Next (A); end loop; @@ -1349,9 +1349,7 @@ package body Sem_Ch13 is while Present (A) loop A_Name := Chars (Identifier (A)); - if A_Name = Name_Import or else - A_Name = Name_Export - then + if Nam_In (A_Name, Name_Import, Name_Export) then if Found then Error_Msg_N ("conflicting", A); else @@ -7568,13 +7566,10 @@ package body Sem_Ch13 is Check_Expr_Constants (Prefix (Nod)); when N_Attribute_Reference => - if Attribute_Name (Nod) = Name_Address - or else - Attribute_Name (Nod) = Name_Access - or else - Attribute_Name (Nod) = Name_Unchecked_Access - or else - Attribute_Name (Nod) = Name_Unrestricted_Access + if Nam_In (Attribute_Name (Nod), Name_Address, + Name_Access, + Name_Unchecked_Access, + Name_Unrestricted_Access) then Check_At_Constant_Address (Prefix (Nod)); @@ -7739,10 +7734,7 @@ package body Sem_Ch13 is -- record, both at location zero. This seems a bit strange, but -- it seems to happen in some circumstances, perhaps on an error. - if Chars (C1_Ent) = Name_uTag - and then - Chars (C2_Ent) = Name_uTag - then + if Nam_In (Chars (C1_Ent), Name_uTag, Name_uTag) then return; end if; @@ -9322,11 +9314,8 @@ package body Sem_Ch13 is declare Pname : constant Name_Id := Pragma_Name (N); begin - if Pname = Name_Convention or else - Pname = Name_Import or else - Pname = Name_Export or else - Pname = Name_External or else - Pname = Name_Interface + if Nam_In (Pname, Name_Convention, Name_Import, Name_Export, + Name_External, Name_Interface) then return False; end if; @@ -9928,8 +9917,7 @@ package body Sem_Ch13 is procedure No_Independence is begin if Pragma_Name (N) = Name_Independent then - Error_Msg_NE - ("independence cannot be guaranteed for&", N, E); + Error_Msg_NE ("independence cannot be guaranteed for&", N, E); else Error_Msg_NE ("independent components cannot be guaranteed for&", N, E); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index fc74beeb5e6..9a687dbfaa7 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -9651,7 +9651,7 @@ package body Sem_Ch3 is elsif Is_Subprogram (E) and then (not Comes_From_Source (E) - or else Chars (E) = Name_uCall) + or else Chars (E) = Name_uCall) then null; @@ -12068,9 +12068,9 @@ package body Sem_Ch3 is Set_Ekind (Def_Id, E_Signed_Integer_Subtype); end if; - Set_Etype (Def_Id, Base_Type (T)); - Set_Size_Info (Def_Id, (T)); - Set_First_Rep_Item (Def_Id, First_Rep_Item (T)); + Set_Etype (Def_Id, Base_Type (T)); + Set_Size_Info (Def_Id, (T)); + Set_First_Rep_Item (Def_Id, First_Rep_Item (T)); Set_Discrete_RM_Size (Def_Id); end Constrain_Integer; @@ -12086,10 +12086,10 @@ package body Sem_Ch3 is begin Set_Ekind (Def_Id, E_Ordinary_Fixed_Point_Subtype); - Set_Etype (Def_Id, Base_Type (T)); - Set_Size_Info (Def_Id, (T)); - Set_First_Rep_Item (Def_Id, First_Rep_Item (T)); - Set_Small_Value (Def_Id, Small_Value (T)); + Set_Etype (Def_Id, Base_Type (T)); + Set_Size_Info (Def_Id, (T)); + Set_First_Rep_Item (Def_Id, First_Rep_Item (T)); + Set_Small_Value (Def_Id, Small_Value (T)); -- Process the constraint @@ -12437,9 +12437,7 @@ package body Sem_Ch3 is then Old_C := First_Component (Typ); while Present (Old_C) loop - if Chars ((Old_C)) = Name_uTag - or else Chars ((Old_C)) = Name_uParent - then + if Nam_In (Chars (Old_C), Name_uTag, Name_uParent) then Append_Elmt (Old_C, Comp_List); end if; @@ -13276,9 +13274,9 @@ package body Sem_Ch3 is or else Is_Internal (Parent_Subp) or else Is_Private_Overriding or else Is_Internal_Name (Chars (Parent_Subp)) - or else Chars (Parent_Subp) = Name_Initialize - or else Chars (Parent_Subp) = Name_Adjust - or else Chars (Parent_Subp) = Name_Finalize + or else Nam_In (Chars (Parent_Subp), Name_Initialize, + Name_Adjust, + Name_Finalize) then Set_Derived_Name; @@ -13451,10 +13449,9 @@ package body Sem_Ch3 is -- set on both views of the type. if Is_Controlled (Parent_Type) - and then - (Chars (Parent_Subp) = Name_Initialize or else - Chars (Parent_Subp) = Name_Adjust or else - Chars (Parent_Subp) = Name_Finalize) + and then Nam_In (Chars (Parent_Subp), Name_Initialize, + Name_Adjust, + Name_Finalize) and then Is_Hidden (Parent_Subp) and then not Is_Visibly_Controlled (Parent_Type) then @@ -19326,7 +19323,7 @@ package body Sem_Ch3 is or else (Is_Class_Wide_Type (Entity (Subt)) and then - Chars (Etype (Base_Type (Entity (Subt)))) = + Chars (Etype (Base_Type (Entity (Subt)))) = Type_Id)); end if; @@ -20162,7 +20159,7 @@ package body Sem_Ch3 is -- Complete both implicit base and declared first subtype entities - Set_Etype (Implicit_Base, Base_Typ); + Set_Etype (Implicit_Base, Base_Typ); Set_Size_Info (Implicit_Base, (Base_Typ)); Set_RM_Size (Implicit_Base, RM_Size (Base_Typ)); Set_First_Rep_Item (Implicit_Base, First_Rep_Item (Base_Typ)); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 6ff707ab9e4..83d71aa8aa2 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4111,13 +4111,11 @@ package body Sem_Ch4 is and then Nkind (Name) /= N_Selected_Component) or else (Nkind (Parent_N) = N_Attribute_Reference - and then (Attribute_Name (Parent_N) = Name_First - or else - Attribute_Name (Parent_N) = Name_Last - or else - Attribute_Name (Parent_N) = Name_Length - or else - Attribute_Name (Parent_N) = Name_Range))) + and then + Nam_In (Attribute_Name (Parent_N), Name_First, + Name_Last, + Name_Length, + Name_Range))) then Set_Etype (N, Etype (Comp)); @@ -4780,9 +4778,9 @@ package body Sem_Ch4 is elsif Nkind (Expr) = N_Attribute_Reference and then - (Attribute_Name (Expr) = Name_Access or else - Attribute_Name (Expr) = Name_Unchecked_Access or else - Attribute_Name (Expr) = Name_Unrestricted_Access) + Nam_In (Attribute_Name (Expr), Name_Access, + Name_Unchecked_Access, + Name_Unrestricted_Access) then Error_Msg_N ("argument of conversion cannot be access", N); Error_Msg_N ("\use qualified expression instead", N); @@ -5037,8 +5035,7 @@ package body Sem_Ch4 is -- Start of processing for Check_Arithmetic_Pair begin - if Op_Name = Name_Op_Add or else Op_Name = Name_Op_Subtract then - + if Nam_In (Op_Name, Name_Op_Add, Name_Op_Subtract) then if Is_Numeric_Type (T1) and then Is_Numeric_Type (T2) and then (Covers (T1 => T1, T2 => T2) @@ -5048,11 +5045,9 @@ package body Sem_Ch4 is Add_One_Interp (N, Op_Id, Specific_Type (T1, T2)); end if; - elsif Op_Name = Name_Op_Multiply or else Op_Name = Name_Op_Divide then - + elsif Nam_In (Op_Name, Name_Op_Multiply, Name_Op_Divide) then if Is_Fixed_Point_Type (T1) - and then (Is_Fixed_Point_Type (T2) - or else T2 = Universal_Real) + and then (Is_Fixed_Point_Type (T2) or else T2 = Universal_Real) then -- If Treat_Fixed_As_Integer is set then the Etype is already set -- and no further processing is required (this is the case of an @@ -5090,7 +5085,7 @@ package body Sem_Ch4 is elsif Is_Fixed_Point_Type (T1) and then (Base_Type (T2) = Base_Type (Standard_Integer) - or else T2 = Universal_Integer) + or else T2 = Universal_Integer) then Add_One_Interp (N, Op_Id, T1); @@ -5107,7 +5102,7 @@ package body Sem_Ch4 is elsif Is_Fixed_Point_Type (T2) and then (Base_Type (T1) = Base_Type (Standard_Integer) - or else T1 = Universal_Integer) + or else T1 = Universal_Integer) and then Op_Name = Name_Op_Multiply then Add_One_Interp (N, Op_Id, T2); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 7a6536f1163..6f2bee5659c 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1461,9 +1461,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 (Attribute_Name (P) = Name_Elab_Spec or else - Attribute_Name (P) = Name_Elab_Body or else - Attribute_Name (P) = Name_Elab_Subp_Body) + and then Nam_In (Attribute_Name (P), Name_Elab_Spec, + Name_Elab_Body, + Name_Elab_Subp_Body) then if Present (Actuals) then Error_Msg_N @@ -4010,9 +4010,8 @@ package body Sem_Ch6 is Nxt := Next (Decl); if Nkind (Decl) = N_Pragma - and then (Pragma_Name (Decl) = Name_Unreferenced - or else - Pragma_Name (Decl) = Name_Unmodified) + and then Nam_In (Pragma_Name (Decl), Name_Unreferenced, + Name_Unmodified) then Remove (Decl); end if; @@ -4515,8 +4514,8 @@ package body Sem_Ch6 is Conv := Current_Entity (Id); elsif Nkind_In (Id, N_Selected_Component, N_Expanded_Name) - and then Chars (Selector_Name (Id)) - = Name_Unchecked_Conversion + and then + Chars (Selector_Name (Id)) = Name_Unchecked_Conversion then Conv := Current_Entity (Selector_Name (Id)); else @@ -5100,9 +5099,8 @@ package body Sem_Ch6 is Nxt := Next (Decl); if Nkind (Decl) = N_Pragma - and then (Pragma_Name (Decl) = Name_Unreferenced - or else - Pragma_Name (Decl) = Name_Unmodified) + and then Nam_In (Pragma_Name (Decl), Name_Unreferenced, + Name_Unmodified) then Remove (Decl); end if; @@ -6499,11 +6497,9 @@ package body Sem_Ch6 is if Present (Overridden_Subp) and then (not Is_Hidden (Overridden_Subp) or else - ((Chars (Overridden_Subp) = Name_Initialize - or else - Chars (Overridden_Subp) = Name_Adjust - or else - Chars (Overridden_Subp) = Name_Finalize) + (Nam_In (Chars (Overridden_Subp), Name_Initialize, + Name_Adjust, + Name_Finalize) and then Present (Alias (Overridden_Subp)) and then not Is_Hidden (Alias (Overridden_Subp)))) then @@ -12910,16 +12906,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 Id = Name_Op_Not - or else Id = Name_Op_Abs - then + if Nam_In (Id, Name_Op_Not, Name_Op_Abs) then N_OK := (N = 1); -- Case of operators which can be unary or binary - elsif Id = Name_Op_Add - or Id = Name_Op_Subtract - then + elsif Nam_In (Id, Name_Op_Add, Name_Op_Subtract) then N_OK := (N in 1 .. 2); -- All other operators can only be binary diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index dd1e1d4120e..f8e2799dc85 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -1394,9 +1394,8 @@ package body Sem_Ch7 is begin ASN := First (Aspect_Specifications (Parent (E))); while Present (ASN) loop - if Chars (Identifier (ASN)) = Name_Invariant - or else - Chars (Identifier (ASN)) = Name_Type_Invariant + if Nam_In (Chars (Identifier (ASN)), Name_Invariant, + Name_Type_Invariant) then Build_Invariant_Procedure (E, N); exit; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 06dddf54f59..12b37f447a4 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3362,13 +3362,9 @@ package body Sem_Ch8 is Error_Msg_N ("illegal expressions in attribute reference", Nam); elsif - Aname = Name_Compose or else - Aname = Name_Exponent or else - Aname = Name_Leading_Part or else - Aname = Name_Pos or else - Aname = Name_Round or else - Aname = Name_Scaling or else - Aname = Name_Val + Nam_In (Aname, Name_Compose, Name_Exponent, Name_Leading_Part, + Name_Pos, Name_Round, Name_Scaling, + Name_Val) then if Nkind (N) = N_Subprogram_Renaming_Declaration and then Present (Corresponding_Formal_Spec (N)) @@ -4569,7 +4565,7 @@ package body Sem_Ch8 is -- is put or put_line, then add a special error message (since -- this is a very common error for beginners to make). - if Chars (N) = Name_Put or else Chars (N) = Name_Put_Line then + if Nam_In (Chars (N), Name_Put, Name_Put_Line) then Error_Msg_N -- CODEFIX ("\\possible missing `WITH Ada.Text_'I'O; " & "USE Ada.Text_'I'O`!", N); diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index db266e874ad..e60574a1496 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -1213,9 +1213,7 @@ package body Sem_Disp is Check_Subtype_Conformant (Subp, Ovr_Subp); - if (Chars (Subp) = Name_Initialize - or else Chars (Subp) = Name_Adjust - or else Chars (Subp) = Name_Finalize) + if Nam_In (Chars (Subp), Name_Initialize, Name_Adjust, Name_Finalize) and then Is_Controlled (Tagged_Type) and then not Is_Visibly_Controlled (Tagged_Type) then @@ -1386,11 +1384,10 @@ package body Sem_Disp is Set_DT_Position (Subp, No_Uint); elsif Has_Controlled_Component (Tagged_Type) - and then - (Chars (Subp) = Name_Initialize or else - Chars (Subp) = Name_Adjust or else - Chars (Subp) = Name_Finalize or else - Chars (Subp) = Name_Finalize_Address) + and then Nam_In (Chars (Subp), Name_Initialize, + Name_Adjust, + Name_Finalize, + Name_Finalize_Address) then declare F_Node : constant Node_Id := Freeze_Node (Tagged_Type); diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index fe640d5e204..6d941025c0d 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -2021,9 +2021,8 @@ package body Sem_Elab is elsif not Debug_Flag_Dot_UU and then Nkind (N) = N_Attribute_Reference - and then (Attribute_Name (N) = Name_Access - or else - Attribute_Name (N) = Name_Unrestricted_Access) + and then Nam_In (Attribute_Name (N), Name_Access, + Name_Unrestricted_Access) and then Is_Entity_Name (Prefix (N)) and then Is_Subprogram (Entity (Prefix (N))) then diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 254f47a9a15..0f3d55db3da 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -528,9 +528,7 @@ package body Sem_Eval is -- Fixup only required for First/Last attribute reference if Nkind (N) = N_Attribute_Reference - and then (Attribute_Name (N) = Name_First - or else - Attribute_Name (N) = Name_Last) + and then Nam_In (Attribute_Name (N), Name_First, Name_Last) then Xtyp := Etype (Prefix (N)); @@ -697,9 +695,7 @@ package body Sem_Eval is elsif Nkind (Lf) = N_Attribute_Reference and then Attribute_Name (Lf) = Attribute_Name (Rf) - and then (Attribute_Name (Lf) = Name_First - or else - Attribute_Name (Lf) = Name_Last) + and then Nam_In (Attribute_Name (Lf), Name_First, Name_Last) and then Nkind_In (Prefix (Lf), N_Identifier, N_Expanded_Name) and then Nkind_In (Prefix (Rf), N_Identifier, N_Expanded_Name) and then Entity (Prefix (Lf)) = Entity (Prefix (Rf)) diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb index fe3855d33d6..ed607ce53c1 100644 --- a/gcc/ada/sem_intr.adb +++ b/gcc/ada/sem_intr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -127,11 +127,9 @@ package body Sem_Intr is -- literal is legal even in Ada 83 mode, where such literals are -- not static. - if Cnam = Name_Import_Address - or else - Cnam = Name_Import_Largest_Value - or else - Cnam = Name_Import_Value + if Nam_In (Cnam, Name_Import_Address, + Name_Import_Largest_Value, + Name_Import_Value) then if Etype (Arg1) = Any_Type or else Raises_Constraint_Error (Arg1) @@ -196,30 +194,13 @@ package body Sem_Intr is begin -- Arithmetic operators - if Nam = Name_Op_Add - or else - Nam = Name_Op_Subtract - or else - Nam = Name_Op_Multiply - or else - Nam = Name_Op_Divide - or else - Nam = Name_Op_Rem - or else - Nam = Name_Op_Mod - or else - Nam = Name_Op_Abs + if Nam_In (Nam, Name_Op_Add, Name_Op_Subtract, Name_Op_Multiply, + Name_Op_Divide, Name_Op_Rem, Name_Op_Mod, Name_Op_Abs) then T1 := Etype (First_Formal (E)); if No (Next_Formal (First_Formal (E))) then - - if Nam = Name_Op_Add - or else - Nam = Name_Op_Subtract - or else - Nam = Name_Op_Abs - then + if Nam_In (Nam, Name_Op_Add, Name_Op_Subtract, Name_Op_Abs) then T2 := T1; -- Previous error in declaration @@ -254,17 +235,8 @@ package body Sem_Intr is -- Comparison operators - elsif Nam = Name_Op_Eq - or else - Nam = Name_Op_Ge - or else - Nam = Name_Op_Gt - or else - Nam = Name_Op_Le - or else - Nam = Name_Op_Lt - or else - Nam = Name_Op_Ne + elsif Nam_In (Nam, Name_Op_Eq, Name_Op_Ge, Name_Op_Gt, Name_Op_Le, + Name_Op_Lt, Name_Op_Ne) then T1 := Etype (First_Formal (E)); @@ -370,35 +342,22 @@ package body Sem_Intr is -- Shift cases. We allow user specification of intrinsic shift -- operators for any numeric types. - elsif - Nam = Name_Rotate_Left - or else - Nam = Name_Rotate_Right - or else - Nam = Name_Shift_Left - or else - Nam = Name_Shift_Right - or else - Nam = Name_Shift_Right_Arithmetic + elsif Nam_In (Nam, Name_Rotate_Left, Name_Rotate_Right, Name_Shift_Left, + Name_Shift_Right, Name_Shift_Right_Arithmetic) then Check_Shift (E, N); - elsif - Nam = Name_Exception_Information - or else - Nam = Name_Exception_Message - or else - Nam = Name_Exception_Name + elsif Nam_In (Nam, Name_Exception_Information, + Name_Exception_Message, + Name_Exception_Name) then Check_Exception_Function (E, N); elsif Nkind (E) = N_Defining_Operator_Symbol then Check_Intrinsic_Operator (E, N); - elsif Nam = Name_File - or else Nam = Name_Line - or else Nam = Name_Source_Location - or else Nam = Name_Enclosing_Entity + elsif Nam_In (Nam, Name_File, Name_Line, Name_Source_Location, + Name_Enclosing_Entity) then null; diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb index e2fce979a22..924b58c76af 100644 --- a/gcc/ada/sem_mech.adb +++ b/gcc/ada/sem_mech.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2013, 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- -- @@ -110,8 +110,9 @@ package body Sem_Mech is Class := First (Expressions (Mech_Name)); if Nkind (Prefix (Mech_Name)) /= N_Identifier - or else not (Chars (Prefix (Mech_Name)) = Name_Descriptor or else - Chars (Prefix (Mech_Name)) = Name_Short_Descriptor) + or else + not Nam_In (Chars (Prefix (Mech_Name)), Name_Descriptor, + Name_Short_Descriptor) or else Present (Next (Class)) then Bad_Mechanism; @@ -129,8 +130,9 @@ package body Sem_Mech is Param := First (Parameter_Associations (Mech_Name)); if Nkind (Name (Mech_Name)) /= N_Identifier - or else not (Chars (Name (Mech_Name)) = Name_Descriptor or else - Chars (Name (Mech_Name)) = Name_Short_Descriptor) + or else + not Nam_In (Chars (Name (Mech_Name)), Name_Descriptor, + Name_Short_Descriptor) or else Present (Next (Param)) or else No (Selector_Name (Param)) or else Chars (Selector_Name (Param)) /= Name_Class diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index af5c1280da1..8cd435b065b 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -306,10 +306,7 @@ package body Sem_Prag is -- Preanalyze the boolean expressions, we treat these as spec -- expressions (i.e. similar to a default expression). - if Pragma_Name (N) = Name_Test_Case - or else - Pragma_Name (N) = Name_Contract_Case - then + if Nam_In (Pragma_Name (N), Name_Test_Case, Name_Contract_Case) then Preanalyze_CTC_Args (N, Get_Requires_From_CTC_Pragma (N), @@ -1321,7 +1318,7 @@ package body Sem_Prag is begin Check_Arg_Is_Identifier (Argx); - if Chars (Argx) /= N1 and then Chars (Argx) /= N2 then + if not Nam_In (Chars (Argx), N1, N2) then Error_Msg_Name_2 := N1; Error_Msg_Name_3 := N2; Error_Pragma_Arg ("argument for pragma% must be% or%", Argx); @@ -1337,10 +1334,7 @@ package body Sem_Prag is begin Check_Arg_Is_Identifier (Argx); - if Chars (Argx) /= N1 - and then Chars (Argx) /= N2 - and then Chars (Argx) /= N3 - then + if not Nam_In (Chars (Argx), N1, N2, N3) then Error_Pragma_Arg ("invalid argument for pragma%", Argx); end if; end Check_Arg_Is_One_Of; @@ -1354,11 +1348,7 @@ package body Sem_Prag is begin Check_Arg_Is_Identifier (Argx); - if Chars (Argx) /= N1 - and then Chars (Argx) /= N2 - and then Chars (Argx) /= N3 - and then Chars (Argx) /= N4 - then + if not Nam_In (Chars (Argx), N1, N2, N3, N4) then Error_Pragma_Arg ("invalid argument for pragma%", Argx); end if; end Check_Arg_Is_One_Of; @@ -1372,12 +1362,7 @@ package body Sem_Prag is begin Check_Arg_Is_Identifier (Argx); - if Chars (Argx) /= N1 - and then Chars (Argx) /= N2 - and then Chars (Argx) /= N3 - and then Chars (Argx) /= N4 - and then Chars (Argx) /= N5 - then + if not Nam_In (Chars (Argx), N1, N2, N3, N4, N5) then Error_Pragma_Arg ("invalid argument for pragma%", Argx); end if; end Check_Arg_Is_One_Of; @@ -2179,9 +2164,7 @@ package body Sem_Prag is procedure Check_No_Link_Name is begin - if Present (Arg3) - and then Chars (Arg3) = Name_Link_Name - then + if Present (Arg3) and then Chars (Arg3) = Name_Link_Name then Arg4 := Arg3; end if; @@ -3499,19 +3482,16 @@ package body Sem_Prag is then -- Give error if same as our pragma or Export/Convention - if Pragma_Name (Decl) = Name_Export - or else - Pragma_Name (Decl) = Name_Convention - or else - Pragma_Name (Decl) = Pragma_Name (N) + if Nam_In (Pragma_Name (Decl), Name_Export, + Name_Convention, + Pragma_Name (N)) then exit; -- Case of Import/Interface or the other way round - elsif Pragma_Name (Decl) = Name_Interface - or else - Pragma_Name (Decl) = Name_Import + elsif Nam_In (Pragma_Name (Decl), Name_Interface, + Name_Import) then -- Here we know that we have Import and Interface. It -- doesn't matter which way round they are. See if @@ -4287,9 +4267,7 @@ package body Sem_Prag is elsif Etype (Def_Id) /= Standard_Void_Type and then - (Pname = Name_Export_Procedure - or else - Pname = Name_Import_Procedure) + Nam_In (Pname, Name_Export_Procedure, Name_Import_Procedure) then Match := False; @@ -6409,9 +6387,10 @@ package body Sem_Prag is Class := First (Expressions (Mech_Name)); if Nkind (Prefix (Mech_Name)) /= N_Identifier - or else not (Chars (Prefix (Mech_Name)) = Name_Descriptor or else - Chars (Prefix (Mech_Name)) = Name_Short_Descriptor) - or else Present (Next (Class)) + or else + not Nam_In (Chars (Prefix (Mech_Name)), Name_Descriptor, + Name_Short_Descriptor) + or else Present (Next (Class)) then Bad_Mechanism; else @@ -6436,8 +6415,9 @@ package body Sem_Prag is Param := First (Parameter_Associations (Mech_Name)); if Nkind (Name (Mech_Name)) /= N_Identifier - or else not (Chars (Name (Mech_Name)) = Name_Descriptor or else - Chars (Name (Mech_Name)) = Name_Short_Descriptor) + or else + not Nam_In (Chars (Name (Mech_Name)), Name_Descriptor, + Name_Short_Descriptor) or else Present (Next (Param)) or else No (Selector_Name (Param)) or else Chars (Selector_Name (Param)) /= Name_Class @@ -9722,11 +9702,11 @@ package body Sem_Prag is Mode : Name_Id) is begin - if Mode = Name_In_Out or else Mode = Name_Input then + if Nam_In (Mode, Name_In_Out, Name_Input) then Add_Item (Item, Subp_Inputs); end if; - if Mode = Name_In_Out or else Mode = Name_Output then + if Nam_In (Mode, Name_In_Out, Name_Output) then Add_Item (Item, Subp_Outputs); end if; end Collect_Global_Item; @@ -11574,9 +11554,7 @@ package body Sem_Prag is -- volatile Input state. if Is_Input_State (Item_Id) - and then (Global_Mode = Name_In_Out - or else - Global_Mode = Name_Output) + and then Nam_In (Global_Mode, Name_In_Out, Name_Output) then Error_Msg_N ("global item of mode In_Out or Output cannot " @@ -11586,9 +11564,7 @@ package body Sem_Prag is -- a volatile Output state. elsif Is_Output_State (Item_Id) - and then (Global_Mode = Name_In_Out - or else - Global_Mode = Name_Input) + and then Nam_In (Global_Mode, Name_In_Out, Name_Input) then Error_Msg_N ("global item of mode In_Out or Input cannot " @@ -13845,8 +13821,8 @@ package body Sem_Prag is Variant := First (Pragma_Argument_Associations (N)); while Present (Variant) loop - if Chars (Variant) /= Name_Decreases - and then Chars (Variant) /= Name_Increases + if not Nam_In (Chars (Variant), Name_Decreases, + Name_Increases) then Error_Pragma_Arg ("wrong change modifier", Variant); end if; @@ -17491,10 +17467,7 @@ package body Sem_Prag is -- On/Off one argument case was processed by parser if Nkind (Argx) = N_Identifier - and then - (Chars (Argx) = Name_On - or else - Chars (Argx) = Name_Off) + and then Nam_In (Chars (Argx), Name_On, Name_Off) then null; @@ -17896,9 +17869,8 @@ package body Sem_Prag is function Delay_Config_Pragma_Analyze (N : Node_Id) return Boolean is begin - return Pragma_Name (N) = Name_Interrupt_State - or else - Pragma_Name (N) = Name_Priority_Specific_Dispatching; + return Nam_In (Pragma_Name (N), Name_Interrupt_State, + Name_Priority_Specific_Dispatching); end Delay_Config_Pragma_Analyze; ------------------------- diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 02a5cda8403..f78f2ae2d48 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -1005,9 +1005,9 @@ package body Sem_Res is -- functions, this is never a parameterless call (RM 4.1.4(6)). if Nkind (Parent (N)) = N_Attribute_Reference - and then (Attribute_Name (Parent (N)) = Name_Address or else - Attribute_Name (Parent (N)) = Name_Code_Address or else - Attribute_Name (Parent (N)) = Name_Access) + and then Nam_In (Attribute_Name (Parent (N)), Name_Address, + Name_Code_Address, + Name_Access) then return False; end if; @@ -1373,7 +1373,7 @@ package body Sem_Res is elsif In_Instance then null; - elsif (Op_Name = Name_Op_Multiply or else Op_Name = Name_Op_Divide) + elsif Nam_In (Op_Name, Name_Op_Multiply, Name_Op_Divide) and then Is_Fixed_Point_Type (Etype (Left_Opnd (Op_Node))) and then Is_Fixed_Point_Type (Etype (Right_Opnd (Op_Node))) then @@ -1385,7 +1385,7 @@ package body Sem_Res is -- available. elsif Ada_Version >= Ada_2005 - and then (Op_Name = Name_Op_Eq or else Op_Name = Name_Op_Ne) + and then Nam_In (Op_Name, Name_Op_Eq, Name_Op_Ne) and then Ekind (Etype (Act1)) = E_Anonymous_Access_Type then null; @@ -1496,9 +1496,7 @@ package body Sem_Res is and then not In_Instance then if Is_Fixed_Point_Type (Typ) - and then (Op_Name = Name_Op_Multiply - or else - Op_Name = Name_Op_Divide) + and then Nam_In (Op_Name, Name_Op_Multiply, Name_Op_Divide) then -- Already checked above @@ -1534,7 +1532,7 @@ package body Sem_Res is -- the equality node will not resolve any remaining ambiguity, and it -- assumes that the first operand is not overloaded. - if (Op_Name = Name_Op_Eq or else Op_Name = Name_Op_Ne) + if Nam_In (Op_Name, Name_Op_Eq, Name_Op_Ne) and then Ekind (Func) = E_Function and then Is_Overloaded (Act1) then @@ -1947,9 +1945,9 @@ package body Sem_Res is -- access-to-subprogram type. if Nkind (N) = N_Attribute_Reference - and then (Attribute_Name (N) = Name_Access or else - Attribute_Name (N) = Name_Unrestricted_Access or else - Attribute_Name (N) = Name_Unchecked_Access) + and then Nam_In (Attribute_Name (N), Name_Access, + Name_Unrestricted_Access, + Name_Unchecked_Access) and then Comes_From_Source (N) and then Is_Entity_Name (Prefix (N)) and then Is_Subprogram (Entity (Prefix (N))) diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index fb897755e33..fa5c085392f 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -2057,8 +2057,7 @@ package body Sem_Type is and then not In_Instance then if Is_Fixed_Point_Type (Typ) - and then (Chars (Nam1) = Name_Op_Multiply - or else Chars (Nam1) = Name_Op_Divide) + and then Nam_In (Chars (Nam1), Name_Op_Multiply, Name_Op_Divide) and then (Ada_Version = Ada_83 or else @@ -2079,9 +2078,7 @@ package body Sem_Type is -- declared in the same declarative list as the type. The node -- may be an operator or a function call. - elsif (Chars (Nam1) = Name_Op_Eq - or else - Chars (Nam1) = Name_Op_Ne) + elsif Nam_In (Chars (Nam1), Name_Op_Eq, Name_Op_Ne) and then Ada_Version >= Ada_2005 and then Etype (User_Subp) = Standard_Boolean and then Ekind (Operand_Type) = E_Anonymous_Access_Type @@ -3059,10 +3056,7 @@ package body Sem_Type is elsif Num = 1 then T1 := Etype (First_Formal (New_S)); - if Op_Name = Name_Op_Subtract - or else Op_Name = Name_Op_Add - or else Op_Name = Name_Op_Abs - then + if Nam_In (Op_Name, Name_Op_Subtract, Name_Op_Add, Name_Op_Abs) then return Base_Type (T1) = Base_Type (T) and then Is_Numeric_Type (T); @@ -3080,26 +3074,24 @@ package body Sem_Type is T1 := Etype (First_Formal (New_S)); T2 := Etype (Next_Formal (First_Formal (New_S))); - if Op_Name = Name_Op_And or else Op_Name = Name_Op_Or - or else Op_Name = Name_Op_Xor - then + if Nam_In (Op_Name, Name_Op_And, Name_Op_Or, Name_Op_Xor) then return Base_Type (T1) = Base_Type (T2) and then Base_Type (T1) = Base_Type (T) and then Valid_Boolean_Arg (Base_Type (T)); - elsif Op_Name = Name_Op_Eq or else Op_Name = Name_Op_Ne then + elsif Nam_In (Op_Name, Name_Op_Eq, Name_Op_Ne) then return Base_Type (T1) = Base_Type (T2) and then not Is_Limited_Type (T1) and then Is_Boolean_Type (T); - elsif Op_Name = Name_Op_Lt or else Op_Name = Name_Op_Le - or else Op_Name = Name_Op_Gt or else Op_Name = Name_Op_Ge + elsif Nam_In (Op_Name, Name_Op_Lt, Name_Op_Le, + Name_Op_Gt, Name_Op_Ge) then return Base_Type (T1) = Base_Type (T2) and then Valid_Comparison_Arg (T1) and then Is_Boolean_Type (T); - elsif Op_Name = Name_Op_Add or else Op_Name = Name_Op_Subtract then + elsif Nam_In (Op_Name, Name_Op_Add, Name_Op_Subtract) then return Base_Type (T1) = Base_Type (T2) and then Base_Type (T1) = Base_Type (T) and then Is_Numeric_Type (T); @@ -3152,7 +3144,7 @@ package body Sem_Type is and then Is_Floating_Point_Type (T2) and then Base_Type (T2) = Base_Type (T)); - elsif Op_Name = Name_Op_Mod or else Op_Name = Name_Op_Rem then + elsif Nam_In (Op_Name, Name_Op_Mod, Name_Op_Rem) then return Base_Type (T1) = Base_Type (T2) and then Base_Type (T1) = Base_Type (T) and then Is_Integer_Type (T); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 533834e7272..00db63d6f9c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -8478,9 +8478,8 @@ package body Sem_Util is begin if Is_Class_Wide_Type (Typ) and then - (Chars (Etype (Typ)) = Name_Forward_Iterator - or else - Chars (Etype (Typ)) = Name_Reversible_Iterator) + Nam_In (Chars (Etype (Typ)), Name_Forward_Iterator, + Name_Reversible_Iterator) and then Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (Etype (Typ)))) @@ -8643,9 +8642,7 @@ package body Sem_Util is -- Attributes 'Input and 'Result produce objects when N_Attribute_Reference => - return Attribute_Name (N) = Name_Input - or else - Attribute_Name (N) = Name_Result; + return Nam_In (Attribute_Name (N), Name_Input, Name_Result); when N_Selected_Component => return @@ -14530,9 +14527,7 @@ package body Sem_Util is return False; elsif not Ekind_In (E, E_Discriminant, E_Component) - or else (Chars (E) = Name_uTag - or else - Chars (E) = Name_uParent) + or else Nam_In (Chars (E), Name_uTag, Name_uParent) then Next_Entity (E); diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 281b6e8fc01..630b635bf23 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -1788,9 +1788,8 @@ package body Sem_Warn is if Nkind (P) = N_Pragma and then - (Pragma_Name (P) = Name_Contract_Case - or else - Pragma_Name (P) = Name_Test_Case) + Nam_In (Pragma_Name (P), Name_Contract_Case, + Name_Test_Case) and then Nod = Get_Ensures_From_CTC_Pragma (P) then @@ -3226,9 +3225,8 @@ package body Sem_Warn is -- node, since assert pragmas get rewritten at analysis time. elsif Nkind (Original_Node (P)) = N_Pragma - and then (Pragma_Name (Original_Node (P)) = Name_Assert - or else - Pragma_Name (Original_Node (P)) = Name_Check) + and then Nam_In (Pragma_Name (Original_Node (P)), Name_Assert, + Name_Check) then return; end if; diff --git a/gcc/ada/tbuild.adb b/gcc/ada/tbuild.adb index 3343d7c81c5..01ea5d56cbd 100644 --- a/gcc/ada/tbuild.adb +++ b/gcc/ada/tbuild.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -174,9 +174,8 @@ package body Tbuild is Attribute_Name => Attribute_Name); begin - pragma Assert (Attribute_Name = Name_Address - or else - Attribute_Name = Name_Unrestricted_Access); + pragma Assert (Nam_In (Attribute_Name, Name_Address, + Name_Unrestricted_Access)); Set_Must_Be_Byte_Aligned (N, True); return N; end Make_Byte_Aligned_Attribute_Reference; |