procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
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.

From-SVN: r197917
This commit is contained in:
Arnaud Charlet 2013-04-12 15:41:03 +02:00
parent 7893514cf6
commit b69cd36a46
41 changed files with 302 additions and 406 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
gcc/ada/ChangeLog
View file

@ -1,3 +1,19 @@
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.

8
gcc/ada/exp_cg.adb
View file

@ -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;

13
gcc/ada/exp_ch2.adb
View file

@ -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

13
gcc/ada/exp_ch3.adb
View file

@ -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???

8
gcc/ada/exp_ch4.adb
View file

@ -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;

14
gcc/ada/exp_ch9.adb
View file

@ -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;

5
gcc/ada/exp_disp.adb
View file

@ -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)

16
gcc/ada/exp_intr.adb
View file

@ -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);

5
gcc/ada/exp_prag.adb
View file

@ -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 ");

8
gcc/ada/exp_util.adb
View file

@ -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;

27
gcc/ada/freeze.adb
View file

@ -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,

15
gcc/ada/init.c
View file

@ -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;

8
gcc/ada/lib-xref.adb
View file

@ -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;

20
gcc/ada/namet.adb
View file

@ -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 --
------------------

10
gcc/ada/namet.ads
View file

@ -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

4
gcc/ada/par-ch2.adb
View file

@ -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

4
gcc/ada/par-prag.adb
View file

@ -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;

5
gcc/ada/par-util.adb
View file

@ -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

8
gcc/ada/prj-makr.adb
View file

@ -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;

9
gcc/ada/prj-nmsc.adb
View file

@ -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);

14
gcc/ada/rtsfind.adb
View file

@ -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;
---------------

25
gcc/ada/sem_attr.adb
View file

@ -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;

12
gcc/ada/sem_aux.adb
View file

@ -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;

11
gcc/ada/sem_ch10.adb
View file

@ -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;

34
gcc/ada/sem_ch13.adb
View file

@ -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);

37
gcc/ada/sem_ch3.adb
View file

@ -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));

31
gcc/ada/sem_ch4.adb
View file

@ -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);

36
gcc/ada/sem_ch6.adb
View file

@ -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

7
gcc/ada/sem_ch7.adb
View file

@ -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;

12
gcc/ada/sem_ch8.adb
View file

@ -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);

13
gcc/ada/sem_disp.adb
View file

@ -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);

5
gcc/ada/sem_elab.adb
View file

@ -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

8
gcc/ada/sem_eval.adb
View file

@ -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))

73
gcc/ada/sem_intr.adb
View file

@ -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;

12
gcc/ada/sem_mech.adb
View file

@ -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

84
gcc/ada/sem_prag.adb
View file

@ -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;
-------------------------

22
gcc/ada/sem_res.adb
View file

@ -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)))

26
gcc/ada/sem_type.adb
View file

@ -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);

13
gcc/ada/sem_util.adb
View file

@ -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);

10
gcc/ada/sem_warn.adb
View file

@ -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;

7
gcc/ada/tbuild.adb
View file

@ -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;