OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2016-04-18  Arnaud Charlet  <charlet@adacore.com>

	* sem_prag.adb (Process_Convention): Relax rule on exporting
	Intrinsic types if Relaxed_RM_Semantics is True.

2016-04-18  Vincent Celier  <celier@adacore.com>

	* sem_ch3.adb, lib.ads, sinfo.ads, sem_ch10.adb, einfo.adb, einfo.ads,
	checks.ads, sem_ch12.adb, sem.adb, sem_util.adb, sem_util.ads,
	sem_res.adb, sem_attr.adb, par.adb, exp_ch4.adb, errout.ads,
	sem_ch4.adb, atree.adb, atree.ads, sem_warn.adb, treepr.adb,
	exp_ch3.ads, exp_unst.adb: Change "descendent" to
	"descendant" in comments, error messages and identifiers.

2016-04-18  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_type.adb (Operator_Matches_Spec): Call First_Formal on
	New_S only once at the beginning of the function.

From-SVN: r235100
This commit is contained in:
Arnaud Charlet 2016-04-18 11:20:56 +02:00
parent 939264d3a3
commit d9d25d048f
26 changed files with 184 additions and 158 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/ada/ChangeLog
View File

@ -1,3 +1,22 @@
2016-04-18 Arnaud Charlet <charlet@adacore.com>
* sem_prag.adb (Process_Convention): Relax rule on exporting
Intrinsic types if Relaxed_RM_Semantics is True.
2016-04-18 Vincent Celier <celier@adacore.com>
* sem_ch3.adb, lib.ads, sinfo.ads, sem_ch10.adb, einfo.adb, einfo.ads,
checks.ads, sem_ch12.adb, sem.adb, sem_util.adb, sem_util.ads,
sem_res.adb, sem_attr.adb, par.adb, exp_ch4.adb, errout.ads,
sem_ch4.adb, atree.adb, atree.ads, sem_warn.adb, treepr.adb,
exp_ch3.ads, exp_unst.adb: Change "descendent" to
"descendant" in comments, error messages and identifiers.
2016-04-18 Eric Botcazou <ebotcazou@adacore.com>
* sem_type.adb (Operator_Matches_Spec): Call First_Formal on
New_S only once at the beginning of the function.
2016-04-02 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (components_to_record): Restrict the previous

10
gcc/ada/atree.adb
View File

@ -905,7 +905,7 @@ package body Atree is
else
New_Id := New_Copy (Source);
-- Recursively copy descendents
-- Recursively copy descendants
Set_Field1 (New_Id, Possible_Copy (Field1 (New_Id)));
Set_Field2 (New_Id, Possible_Copy (Field2 (New_Id)));
@ -2305,11 +2305,11 @@ package body Atree is
if Fld = Union_Id (Empty) then
return OK;
-- Descendent is a node
-- Descendant is a node
elsif Fld in Node_Range then
-- Traverse descendent that is syntactic subtree node
-- Traverse descendant that is syntactic subtree node
if Is_Syntactic_Field (Nkind (Nod), FN) then
return Traverse_Func (Node_Id (Fld));
@ -2320,11 +2320,11 @@ package body Atree is
return OK;
end if;
-- Descendent is a list
-- Descendant is a list
elsif Fld in List_Range then
-- Traverse descendent that is a syntactic subtree list
-- Traverse descendant that is a syntactic subtree list
if Is_Syntactic_Field (Nkind (Nod), FN) then
declare

16
gcc/ada/atree.ads
View File

@ -474,8 +474,8 @@ package Atree is
-- The contents of the source node is not affected. If the source node
-- has an extension, then the destination must have an extension also.
-- The parent pointer of the destination and its list link, if any, are
-- not affected by the copy. Note that parent pointers of descendents
-- are not adjusted, so the descendents of the destination node after
-- not affected by the copy. Note that parent pointers of descendants
-- are not adjusted, so the descendants of the destination node after
-- the Copy_Node is completed have dubious parent pointers. Note that
-- this routine does NOT copy aspect specifications, the Has_Aspects
-- flag in the returned node will always be False. The caller must deal
@ -489,16 +489,16 @@ package Atree is
-- overloaded. The new node will have an extension if the source has
-- an extension. New_Copy (Empty) returns Empty, and New_Copy (Error)
-- returns Error. Note that, unlike Copy_Separate_Tree, New_Copy does not
-- recursively copy any descendents, so in general parent pointers are not
-- set correctly for the descendents of the copied node. Both normal and
-- recursively copy any descendants, so in general parent pointers are not
-- set correctly for the descendants of the copied node. Both normal and
-- extended nodes (entities) may be copied using New_Copy.
function Relocate_Node (Source : Node_Id) return Node_Id;
-- Source is a non-entity node that is to be relocated. A new node is
-- allocated, and the contents of Source are copied to this node, using
-- New_Copy. The parent pointers of descendents of the node are then
-- New_Copy. The parent pointers of descendants of the node are then
-- adjusted to point to the relocated copy. The original node is not
-- modified, but the parent pointers of its descendents are no longer
-- modified, but the parent pointers of its descendants are no longer
-- valid. The new copy is always marked as not overloaded. This routine is
-- used in conjunction with the tree rewrite routines (see descriptions of
-- Replace/Rewrite).
@ -1063,7 +1063,7 @@ package Atree is
-- original node). Neither Old_Node nor New_Node can be extended nodes.
--
-- Note: New_Node may not contain references to Old_Node, for example as
-- descendents, since the rewrite would make such references invalid. If
-- descendants, since the rewrite would make such references invalid. If
-- New_Node does need to reference Old_Node, then these references should
-- be to a relocated copy of Old_Node (see Relocate_Node procedure).
--
@ -1082,7 +1082,7 @@ package Atree is
-- preserves the setting of Comes_From_Source.
--
-- Note, New_Node may not contain references to Old_Node, for example as
-- descendents, since the rewrite would make such references invalid. If
-- descendants, since the rewrite would make such references invalid. If
-- New_Node does need to reference Old_Node, then these references should
-- be to a relocated copy of Old_Node (see Relocate_Node procedure).
--

2
gcc/ada/checks.ads
View File

@ -949,7 +949,7 @@ private
--
-- For the static case the result is one or two nodes that should cause
-- a Constraint_Error. Typically these will include Expr itself or the
-- direct descendents of Expr, such as Low/High_Bound (Expr)). It is the
-- direct descendants of Expr, such as Low/High_Bound (Expr)). It is the
-- responsibility of the caller to rewrite and substitute the nodes with
-- N_Raise_Constraint_Error nodes.
--

24
gcc/ada/einfo.adb
View File

@ -528,7 +528,7 @@ package body Einfo is
-- Has_Pragma_Preelab_Init Flag221
-- Used_As_Generic_Actual Flag222
-- Is_Descendent_Of_Address Flag223
-- Is_Descendant_Of_Address Flag223
-- Is_Raised Flag224
-- Is_Thunk Flag225
-- Is_Only_Out_Parameter Flag226
@ -2101,10 +2101,10 @@ package body Einfo is
return Flag132 (Id);
end Is_Default_Init_Cond_Procedure;
function Is_Descendent_Of_Address (Id : E) return B is
function Is_Descendant_Of_Address (Id : E) return B is
begin
return Flag223 (Id);
end Is_Descendent_Of_Address;
end Is_Descendant_Of_Address;
function Is_Discrim_SO_Function (Id : E) return B is
begin
@ -5102,11 +5102,11 @@ package body Einfo is
Set_Flag132 (Id, V);
end Set_Is_Default_Init_Cond_Procedure;
procedure Set_Is_Descendent_Of_Address (Id : E; V : B := True) is
procedure Set_Is_Descendant_Of_Address (Id : E; V : B := True) is
begin
pragma Assert (Is_Type (Id));
Set_Flag223 (Id, V);
end Set_Is_Descendent_Of_Address;
end Set_Is_Descendant_Of_Address;
procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True) is
begin
@ -7004,17 +7004,19 @@ package body Einfo is
else
Formal := First_Entity (Id);
-- Deal with the common, non-generic case first
if No (Formal) or else Is_Formal (Formal) then
return Formal;
end if;
-- The first/next entity chain of a generic subprogram contains all
-- generic formal parameters, followed by the formal parameters. Go
-- directly to the parameters by skipping the formal part.
-- generic formal parameters, followed by the formal parameters.
if Is_Generic_Subprogram (Id) then
while Present (Formal) and then not Is_Formal (Formal) loop
Next_Entity (Formal);
end loop;
end if;
if Present (Formal) and then Is_Formal (Formal) then
return Formal;
else
return Empty;
@ -8945,7 +8947,7 @@ package body Einfo is
W ("Is_Controlled", Flag42 (Id));
W ("Is_Controlling_Formal", Flag97 (Id));
W ("Is_Default_Init_Cond_Procedure", Flag132 (Id));
W ("Is_Descendent_Of_Address", Flag223 (Id));
W ("Is_Descendant_Of_Address", Flag223 (Id));
W ("Is_Discrim_SO_Function", Flag176 (Id));
W ("Is_Discriminant_Check_Function", Flag264 (Id));
W ("Is_Dispatch_Table_Entity", Flag234 (Id));

14
gcc/ada/einfo.ads
View File

@ -2368,7 +2368,7 @@ package Einfo is
-- Defined in functions and procedures. Set for a generated procedure
-- which verifies the assumption of pragma Default_Initial_Condition.
-- Is_Descendent_Of_Address (Flag223)
-- Is_Descendant_Of_Address (Flag223)
-- Defined in all entities. True if the entity is type System.Address,
-- or (recursively) a subtype or derived type of System.Address.
@ -2929,7 +2929,7 @@ package Einfo is
-- Is_Private_Descendant (Flag53)
-- Defined in entities that can represent library units (packages,
-- functions, procedures). Set if the library unit is itself a private
-- child unit, or if it is the descendent of a private child unit.
-- child unit, or if it is the descendant of a private child unit.
-- Is_Private_Primitive (Flag245)
-- Defined in subprograms. Set if the operation is a primitive of a
@ -5341,7 +5341,7 @@ package Einfo is
-- Is_Checked_Ghost_Entity (Flag277)
-- Is_Child_Unit (Flag73)
-- Is_Compilation_Unit (Flag149)
-- Is_Descendent_Of_Address (Flag223)
-- Is_Descendant_Of_Address (Flag223)
-- Is_Discrim_SO_Function (Flag176)
-- Is_Discriminant_Check_Function (Flag264)
-- Is_Dispatch_Table_Entity (Flag234)
@ -6965,7 +6965,7 @@ package Einfo is
function Is_Controlling_Formal (Id : E) return B;
function Is_CPP_Class (Id : E) return B;
function Is_Default_Init_Cond_Procedure (Id : E) return B;
function Is_Descendent_Of_Address (Id : E) return B;
function Is_Descendant_Of_Address (Id : E) return B;
function Is_Discrim_SO_Function (Id : E) return B;
function Is_Discriminant_Check_Function (Id : E) return B;
function Is_Dispatch_Table_Entity (Id : E) return B;
@ -7628,7 +7628,7 @@ package Einfo is
procedure Set_Is_Controlling_Formal (Id : E; V : B := True);
procedure Set_Is_CPP_Class (Id : E; V : B := True);
procedure Set_Is_Default_Init_Cond_Procedure (Id : E; V : B := True);
procedure Set_Is_Descendent_Of_Address (Id : E; V : B := True);
procedure Set_Is_Descendant_Of_Address (Id : E; V : B := True);
procedure Set_Is_Discrim_SO_Function (Id : E; V : B := True);
procedure Set_Is_Discriminant_Check_Function (Id : E; V : B := True);
procedure Set_Is_Dispatch_Table_Entity (Id : E; V : B := True);
@ -8422,7 +8422,7 @@ package Einfo is
pragma Inline (Is_CPP_Class);
pragma Inline (Is_Decimal_Fixed_Point_Type);
pragma Inline (Is_Default_Init_Cond_Procedure);
pragma Inline (Is_Descendent_Of_Address);
pragma Inline (Is_Descendant_Of_Address);
pragma Inline (Is_Digits_Type);
pragma Inline (Is_Discrete_Or_Fixed_Point_Type);
pragma Inline (Is_Discrete_Type);
@ -8917,7 +8917,7 @@ package Einfo is
pragma Inline (Set_Is_Controlling_Formal);
pragma Inline (Set_Is_CPP_Class);
pragma Inline (Set_Is_Default_Init_Cond_Procedure);
pragma Inline (Set_Is_Descendent_Of_Address);
pragma Inline (Set_Is_Descendant_Of_Address);
pragma Inline (Set_Is_Discrim_SO_Function);
pragma Inline (Set_Is_Discriminant_Check_Function);
pragma Inline (Set_Is_Dispatch_Table_Entity);

2
gcc/ada/errout.ads
View File

@ -793,7 +793,7 @@ package Errout is
procedure Remove_Warning_Messages (N : Node_Id);
-- Remove any warning messages corresponding to the Sloc of N or any
-- of its descendent nodes. No effect if no such warnings. Note that
-- of its descendant nodes. No effect if no such warnings. Note that
-- style messages (identified by the fact that they start with "(style)")
-- are not removed by this call. Basically the idea behind this procedure
-- is to remove warnings about execution conditions from known dead code.

4
gcc/ada/exp_ch3.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2015, 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- --
@ -119,7 +119,7 @@ package Exp_Ch3 is
-- initialization routine:
-- Access types (which need initializing to null)
-- All scalar types if Normalize_Scalars mode set
-- Descendents of standard string types if Normalize_Scalars mode set
-- Descendants of standard string types if Normalize_Scalars mode set
-- Scalar types having a Default_Value attribute
-- Regarding Initialize_Scalars mode, this is ignored if Consider_IS is
-- set to False, but if Consider_IS is set to True, then the cases above

6
gcc/ada/exp_ch4.adb
View File

@ -11243,8 +11243,8 @@ package body Exp_Ch4 is
Set_Do_Overflow_Check (N, False);
if not Is_Descendent_Of_Address (Etype (Expr))
and then not Is_Descendent_Of_Address (Target_Type)
if not Is_Descendant_Of_Address (Etype (Expr))
and then not Is_Descendant_Of_Address (Target_Type)
then
Generate_Range_Check
(Expr, Target_Type, CE_Range_Check_Failed);
@ -11364,7 +11364,7 @@ package body Exp_Ch4 is
-- spurious type error on the literal when Address is a visible
-- integer type.
if Is_Descendent_Of_Address (Target_Type) then
if Is_Descendant_Of_Address (Target_Type) then
Set_Etype (N, Target_Type);
else
Analyze_And_Resolve (N, Target_Type);

2
gcc/ada/exp_unst.adb
View File

@ -589,7 +589,7 @@ package body Exp_Unst is
end;
-- Now at this level, return skipping the subprogram body
-- descendents, since we already took care of them!
-- descendants, since we already took care of them!
return Skip;

2
gcc/ada/lib.ads
View File

@ -580,7 +580,7 @@ package Lib is
function In_Predefined_Unit (N : Node_Or_Entity_Id) return Boolean;
-- Returns True if the given node or entity appears within the source text
-- of a predefined unit (i.e. within Ada, Interfaces, System or within one
-- of the descendent packages of one of these three packages).
-- of the descendant packages of one of these three packages).
function In_Predefined_Unit (S : Source_Ptr) return Boolean;
-- Same function as above but argument is a source pointer

6
gcc/ada/par.adb
View File

@ -1611,7 +1611,7 @@ begin
Name (Name'First .. Name'First + 3) = "ada."
then
Error_Msg
("user-defined descendents of package Ada " &
("user-defined descendants of package Ada " &
"are not allowed",
Sloc (Unit (Comp_Unit_Node)));
@ -1620,7 +1620,7 @@ begin
Name (Name'First .. Name'First + 10) = "interfaces."
then
Error_Msg
("user-defined descendents of package Interfaces " &
("user-defined descendants of package Interfaces " &
"are not allowed",
Sloc (Unit (Comp_Unit_Node)));
@ -1633,7 +1633,7 @@ begin
"system.rpc.")
then
Error_Msg
("user-defined descendents of package System " &
("user-defined descendants of package System " &
"are not allowed",
Sloc (Unit (Comp_Unit_Node)));
end if;

4
gcc/ada/sem.adb
View File

@ -2062,9 +2062,9 @@ package body Sem is
end if;
-- It's a spec, process it, and the units it depends on,
-- unless it is a descendent of the main unit. This can
-- unless it is a descendant of the main unit. This can
-- happen when the body of a parent depends on some other
-- descendent.
-- descendant.
when others =>
Par := Scope (Defining_Entity (Unit (CU)));

2
gcc/ada/sem_attr.adb
View File

@ -9278,7 +9278,7 @@ package body Sem_Attr is
Id : RE_Id;
begin
if Is_Descendent_Of_Address (Typ) then
if Is_Descendant_Of_Address (Typ) then
Id := RE_Type_Class_Address;
elsif Is_Enumeration_Type (Typ) then

2
gcc/ada/sem_ch10.adb
View File

@ -612,7 +612,7 @@ package body Sem_Ch10 is
-- If the unit is a subunit whose parent has not been analyzed (which
-- indicates that the main unit is a subunit, either the current one or
-- one of its descendents) then the subunit is compiled as part of the
-- one of its descendants) then the subunit is compiled as part of the
-- analysis of the parent, which we proceed to do. Basically this gets
-- handled from the top down and we don't want to do anything at this
-- level (i.e. this subunit will be handled on the way down from the

2
gcc/ada/sem_ch12.adb
View File

@ -13880,7 +13880,7 @@ package body Sem_Ch12 is
-- so that it can be properly resolved in a subsequent instantiation.
procedure Save_Global_Descendant (D : Union_Id);
-- Apply Save_References recursively to the descendents of node D
-- Apply Save_References recursively to the descendants of node D
procedure Save_References (N : Node_Id);
-- This is the recursive procedure that does the work, once the

16
gcc/ada/sem_ch3.adb
View File

@ -2915,9 +2915,9 @@ package body Sem_Ch3 is
and then Chars (Def_Id) = Name_Address
and then Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (N)))
then
Set_Is_Descendent_Of_Address (Def_Id);
Set_Is_Descendent_Of_Address (Base_Type (Def_Id));
Set_Is_Descendent_Of_Address (Prev);
Set_Is_Descendant_Of_Address (Def_Id);
Set_Is_Descendant_Of_Address (Base_Type (Def_Id));
Set_Is_Descendant_Of_Address (Prev);
end if;
Set_Optimize_Alignment_Flags (Def_Id);
@ -5063,7 +5063,7 @@ package body Sem_Ch3 is
Set_Is_Immediately_Visible (Id, True);
Set_Depends_On_Private (Id, Has_Private_Component (T));
Set_Is_Descendent_Of_Address (Id, Is_Descendent_Of_Address (T));
Set_Is_Descendant_Of_Address (Id, Is_Descendant_Of_Address (T));
if Is_Interface (T) then
Set_Is_Interface (Id);
@ -6745,10 +6745,10 @@ package body Sem_Ch3 is
Set_Is_Known_Valid (Derived_Type, Is_Known_Valid (Parent_Type));
end if;
Set_Is_Descendent_Of_Address (Derived_Type,
Is_Descendent_Of_Address (Parent_Type));
Set_Is_Descendent_Of_Address (Implicit_Base,
Is_Descendent_Of_Address (Parent_Type));
Set_Is_Descendant_Of_Address (Derived_Type,
Is_Descendant_Of_Address (Parent_Type));
Set_Is_Descendant_Of_Address (Implicit_Base,
Is_Descendant_Of_Address (Parent_Type));
-- Set remaining type-specific fields, depending on numeric type

26
gcc/ada/sem_ch4.adb
View File

@ -3124,10 +3124,10 @@ package body Sem_Ch4 is
-- a visible integer type.
return Hides_Op (Fun, Nam)
or else Is_Descendent_Of_Address (Etype (Form1))
or else Is_Descendant_Of_Address (Etype (Form1))
or else
(Present (Form2)
and then Is_Descendent_Of_Address (Etype (Form2)));
and then Is_Descendant_Of_Address (Etype (Form2)));
end Operator_Hidden_By;
-- Start of processing for Analyze_One_Call
@ -3316,13 +3316,13 @@ package body Sem_Ch4 is
-- The actual can be compatible with the formal, but we must
-- also check that the context is not an address type that is
-- visibly an integer type. In this case the use of literals is
-- illegal, except in the body of descendents of system, where
-- illegal, except in the body of descendants of system, where
-- arithmetic operations on address are of course used.
if Has_Compatible_Type (Actual, Etype (Formal))
and then
(Etype (Actual) /= Universal_Integer
or else not Is_Descendent_Of_Address (Etype (Formal))
or else not Is_Descendant_Of_Address (Etype (Formal))
or else
Is_Predefined_File_Name
(Unit_File_Name (Get_Source_Unit (N))))
@ -6673,8 +6673,8 @@ package body Sem_Ch4 is
return;
elsif Allow_Integer_Address
and then Is_Descendent_Of_Address (Etype (L))
and then Is_Descendent_Of_Address (Etype (R))
and then Is_Descendant_Of_Address (Etype (L))
and then Is_Descendant_Of_Address (Etype (R))
and then not Error_Posted (N)
then
declare
@ -6909,7 +6909,7 @@ package body Sem_Ch4 is
procedure Remove_Abstract_Operations (N : Node_Id) is
Abstract_Op : Entity_Id := Empty;
Address_Descendent : Boolean := False;
Address_Descendant : Boolean := False;
I : Interp_Index;
It : Interp;
@ -6946,8 +6946,8 @@ package body Sem_Ch4 is
Formal := Next_Entity (Formal);
end if;
if Is_Descendent_Of_Address (Etype (Formal)) then
Address_Descendent := True;
if Is_Descendant_Of_Address (Etype (Formal)) then
Address_Descendant := True;
Remove_Interp (I);
end if;
@ -6974,8 +6974,8 @@ package body Sem_Ch4 is
then
Abstract_Op := It.Nam;
if Is_Descendent_Of_Address (It.Typ) then
Address_Descendent := True;
if Is_Descendant_Of_Address (It.Typ) then
Address_Descendant := True;
Remove_Interp (I);
exit;
@ -7068,7 +7068,7 @@ package body Sem_Ch4 is
Get_First_Interp (N, I, It);
while Present (It.Nam) loop
if Is_Descendent_Of_Address (It.Typ) then
if Is_Descendant_Of_Address (It.Typ) then
Remove_Interp (I);
elsif not Is_Type (It.Nam) then
@ -7143,7 +7143,7 @@ package body Sem_Ch4 is
-- predefined operators when addresses are involved since this
-- case is handled separately.
elsif Ada_Version >= Ada_2005 and then not Address_Descendent then
elsif Ada_Version >= Ada_2005 and then not Address_Descendant then
while Present (It.Nam) loop
if Is_Numeric_Type (It.Typ)
and then Scope (It.Typ) = Standard_Standard

8
gcc/ada/sem_prag.adb
View File

@ -7139,8 +7139,12 @@ package body Sem_Prag is
if C = Convention_Intrinsic
and then not Is_Subprogram_Or_Generic_Subprogram (E)
then
Error_Pragma_Arg
("second argument of pragma% must be a subprogram", Arg2);
-- Accept Intrinsic Export on types if Relaxed_RM_Semantics
if not (Is_Type (E) and then Relaxed_RM_Semantics) then
Error_Pragma_Arg
("second argument of pragma% must be a subprogram", Arg2);
end if;
end if;
-- Deal with non-subprogram cases

2
gcc/ada/sem_res.adb
View File

@ -12080,7 +12080,7 @@ package body Sem_Res is
-- operations must be done explicitly here.
if not Address_Is_Private
and then Is_Descendent_Of_Address (It.Typ)
and then Is_Descendant_Of_Address (It.Typ)
then
Remove_Interp (I);
end if;

23
gcc/ada/sem_type.adb
View File

@ -3026,20 +3026,21 @@ package body Sem_Type is
---------------------------
function Operator_Matches_Spec (Op, New_S : Entity_Id) return Boolean is
Op_Name : constant Name_Id := Chars (Op);
T : constant Entity_Id := Etype (New_S);
New_F : Entity_Id;
Old_F : Entity_Id;
Num : Int;
T1 : Entity_Id;
T2 : Entity_Id;
Op_Name : constant Name_Id := Chars (Op);
T : constant Entity_Id := Etype (New_S);
New_First_F : constant Entity_Id := First_Formal (New_S);
New_F : Entity_Id;
Old_F : Entity_Id;
Num : Int;
T1 : Entity_Id;
T2 : Entity_Id;
begin
-- To verify that a predefined operator matches a given signature,
-- do a case analysis of the operator classes. Function can have one
-- or two formals and must have the proper result type.
New_F := First_Formal (New_S);
New_F := New_First_F;
Old_F := First_Formal (Op);
Num := 0;
while Present (New_F) and then Present (Old_F) loop
@ -3056,7 +3057,7 @@ package body Sem_Type is
-- Unary operators
elsif Num = 1 then
T1 := Etype (First_Formal (New_S));
T1 := Etype (New_First_F);
if Nam_In (Op_Name, Name_Op_Subtract, Name_Op_Add, Name_Op_Abs) then
return Base_Type (T1) = Base_Type (T)
@ -3073,8 +3074,8 @@ package body Sem_Type is
-- Binary operators
else
T1 := Etype (First_Formal (New_S));
T2 := Etype (Next_Formal (First_Formal (New_S)));
T1 := Etype (New_First_F);
T2 := Etype (Next_Formal (New_First_F));
if Nam_In (Op_Name, Name_Op_And, Name_Op_Or, Name_Op_Xor) then
return Base_Type (T1) = Base_Type (T2)

28
gcc/ada/sem_util.adb
View File

@ -272,11 +272,11 @@ package body Sem_Util is
function Address_Integer_Convert_OK (T1, T2 : Entity_Id) return Boolean is
begin
if Allow_Integer_Address
and then ((Is_Descendent_Of_Address (T1)
and then ((Is_Descendant_Of_Address (T1)
and then Is_Private_Type (T1)
and then Is_Integer_Type (T2))
or else
(Is_Descendent_Of_Address (T2)
(Is_Descendant_Of_Address (T2)
and then Is_Private_Type (T2)
and then Is_Integer_Type (T1)))
then
@ -2128,7 +2128,7 @@ package body Sem_Util is
T := Full_View (T);
end if;
if Is_Descendent_Of_Address (T) or else Is_Limited_Type (T) then
if Is_Descendant_Of_Address (T) or else Is_Limited_Type (T) then
Set_Is_Pure (Subp_Id, False);
exit;
end if;
@ -11807,10 +11807,10 @@ package body Sem_Util is
end Is_Dereferenced;
----------------------
-- Is_Descendent_Of --
-- Is_Descendant_Of --
----------------------
function Is_Descendent_Of (T1 : Entity_Id; T2 : Entity_Id) return Boolean is
function Is_Descendant_Of (T1 : Entity_Id; T2 : Entity_Id) return Boolean is
T : Entity_Id;
Etyp : Entity_Id;
@ -11863,7 +11863,7 @@ package body Sem_Util is
T := Base_Type (Etyp);
end loop;
end if;
end Is_Descendent_Of;
end Is_Descendant_Of;
----------------------------------------
-- Is_Descendant_Of_Suspension_Object --
@ -15260,7 +15260,7 @@ package body Sem_Util is
procedure Copy_Itype_With_Replacement (New_Itype : Entity_Id);
-- Called during the second phase to process a copied Itype. The actual
-- copy happened during the first phase (so that we could make the entry
-- in the mapping), but we still have to deal with the descendents of
-- in the mapping), but we still have to deal with the descendants of
-- the copied Itype and copy them where necessary.
function Copy_List_With_Replacement (Old_List : List_Id) return List_Id;
@ -15274,7 +15274,7 @@ package body Sem_Util is
procedure Visit_Field (F : Union_Id; N : Node_Id);
-- Visit a single field, recursing to call Visit_Node or Visit_List
-- if the field is a syntactic descendent of the current node (i.e.
-- if the field is a syntactic descendant of the current node (i.e.
-- its parent is Node N).
procedure Visit_Itype (Old_Itype : Entity_Id);
@ -15662,7 +15662,7 @@ package body Sem_Util is
end;
end if;
-- Recursively copy descendents
-- Recursively copy descendants
Set_Field1
(New_Node, Copy_Field_With_Replacement (Field1 (New_Node)));
@ -15923,7 +15923,7 @@ package body Sem_Util is
Set_Cloned_Subtype (New_Itype, Old_Itype);
end if;
-- Visit descendents that eventually get copied
-- Visit descendants that eventually get copied
Visit_Field (Union_Id (Etype (Old_Itype)), Old_Itype);
@ -15980,7 +15980,7 @@ package body Sem_Util is
-- Nothing to do if already in the list. This can happen with an
-- Itype entity that appears more than once in the tree.
-- Note that we do not want to visit descendents in this case.
-- Note that we do not want to visit descendants in this case.
-- Test for already in list when hash table is used
@ -16011,7 +16011,7 @@ package body Sem_Util is
Visit_Itype (N);
end if;
-- Visit descendents
-- Visit descendants
Visit_Field (Field1 (N), N);
Visit_Field (Field2 (N), N);
@ -16053,12 +16053,12 @@ package body Sem_Util is
end if;
-- Hash table set up if required, now start phase one by visiting
-- top node (we will recursively visit the descendents).
-- top node (we will recursively visit the descendants).
Visit_Node (Source);
-- Now the second phase of the copy can start. First we process
-- all the mapped entities, copying their descendents.
-- all the mapped entities, copying their descendants.
if Present (Actual_Map) then
declare

18
gcc/ada/sem_util.ads
View File

@ -62,7 +62,7 @@ package Sem_Util is
function Address_Integer_Convert_OK (T1, T2 : Entity_Id) return Boolean;
-- Given two types, returns True if we are in Allow_Integer_Address mode
-- and one of the types is (a descendent of) System.Address (and this type
-- and one of the types is (a descendant of) System.Address (and this type
-- is private), and the other type is any integer type.
function Addressable (V : Uint) return Boolean;
@ -1327,16 +1327,16 @@ package Sem_Util is
-- access value (selected/indexed component, explicit dereference or a
-- slice), and false otherwise.
function Is_Descendent_Of (T1 : Entity_Id; T2 : Entity_Id) return Boolean;
-- Returns True if type T1 is a descendent of type T2, and false otherwise.
-- This is the RM definition, a type is a descendent of another type if it
-- is the same type or is derived from a descendent of the other type.
function Is_Descendant_Of (T1 : Entity_Id; T2 : Entity_Id) return Boolean;
-- Returns True if type T1 is a descendant of type T2, and false otherwise.
-- This is the RM definition, a type is a descendant of another type if it
-- is the same type or is derived from a descendant of the other type.
function Is_Descendant_Of_Suspension_Object
(Typ : Entity_Id) return Boolean;
-- Determine whether type Typ is a descendant of type Suspension_Object
-- defined in Ada.Synchronous_Task_Control. This version is different from
-- Is_Descendent_Of as the detection of Suspension_Object does not involve
-- Is_Descendant_Of as the detection of Suspension_Object does not involve
-- an entity and by extension a call to RTSfind.
function Is_Double_Precision_Floating_Point_Type
@ -1778,10 +1778,10 @@ package Sem_Util is
New_Sloc : Source_Ptr := No_Location;
New_Scope : Entity_Id := Empty) return Node_Id;
-- Given a node that is the root of a subtree, Copy_Tree copies the entire
-- syntactic subtree, including recursively any descendents whose parent
-- field references a copied node (descendents not linked to a copied node
-- syntactic subtree, including recursively any descendants whose parent
-- field references a copied node (descendants not linked to a copied node
-- by the parent field are not copied, instead the copied tree references
-- the same descendent as the original in this case, which is appropriate
-- the same descendant as the original in this case, which is appropriate
-- for non-syntactic fields such as Etype). The parent pointers in the
-- copy are properly set. Copy_Tree (Empty/Error) returns Empty/Error.
-- The one exception to the rule of not copying semantic fields is that

2
gcc/ada/sem_warn.adb
View File

@ -382,7 +382,7 @@ package body Sem_Warn is
Comp := First_Component (Rec);
while Present (Comp) loop
if Is_Access_Type (Etype (Comp))
or else Is_Descendent_Of_Address (Etype (Comp))
or else Is_Descendant_Of_Address (Etype (Comp))
then
return True;
end if;

2
gcc/ada/sinfo.ads
View File

@ -5268,7 +5268,7 @@ package Sinfo is
-- argument expression has the Do_Range_Check flag set, and the range
-- check is done against the formal type. Note that this argument
-- expression may appear directly in the Parameter_Associations list,
-- or may be a descendent of an N_Parameter_Association node that
-- or may be a descendant of an N_Parameter_Association node that
-- appears in this list.
------------------------

100
gcc/ada/treepr.adb
View File

@ -126,10 +126,10 @@ package body Treepr is
-- value of the field.
procedure Print_Init;
-- Initialize for printing of tree with descendents
-- Initialize for printing of tree with descendants
procedure Print_Term;
-- Clean up after printing of tree with descendents
-- Clean up after printing of tree with descendants
procedure Print_Char (C : Character);
-- Print character C if currently in print phase, noop if in marking phase
@ -202,17 +202,17 @@ package body Treepr is
(N : Node_Id;
Prefix_Str : String;
Prefix_Char : Character);
-- Called to process a single node in the case where descendents are to
-- Called to process a single node in the case where descendants are to
-- be printed before every line, and Prefix_Char added to all lines
-- except the header line for the node.
procedure Visit_List (L : List_Id; Prefix_Str : String);
-- Visit_List is called to process a list in the case where descendents
-- Visit_List is called to process a list in the case where descendants
-- are to be printed. Prefix_Str is to be added to all printed lines.
procedure Visit_Elist (E : Elist_Id; Prefix_Str : String);
-- Visit_Elist is called to process an element list in the case where
-- descendents are to be printed. Prefix_Str is to be added to all
-- descendants are to be printed. Prefix_Str is to be added to all
-- printed lines.
-------
@ -1894,7 +1894,7 @@ package body Treepr is
New_Prefix : String (Prefix_Str'First .. Prefix_Str'Last + 2);
-- Prefix string for printing referenced fields
procedure Visit_Descendent
procedure Visit_Descendant
(D : Union_Id;
No_Indent : Boolean := False);
-- This procedure tests the given value of one of the Fields referenced
@ -1902,23 +1902,23 @@ package body Treepr is
-- Normally No_Indent is false, which means that the visited node will
-- be indented using New_Prefix. If No_Indent is set to True, then
-- this indentation is skipped, and Prefix_Str is used for the call
-- to print the descendent. No_Indent is effective only if the
-- referenced descendent is a node.
-- to print the descendant. No_Indent is effective only if the
-- referenced descendant is a node.
----------------------
-- Visit_Descendent --
-- Visit_Descendant --
----------------------
procedure Visit_Descendent
procedure Visit_Descendant
(D : Union_Id;
No_Indent : Boolean := False)
is
begin
-- Case of descendent is a node
-- Case of descendant is a node
if D in Node_Range then
-- Don't bother about Empty or Error descendents
-- Don't bother about Empty or Error descendants
if D <= Union_Id (Empty_Or_Error) then
return;
@ -1928,7 +1928,7 @@ package body Treepr is
Nod : constant Node_Or_Entity_Id := Node_Or_Entity_Id (D);
begin
-- Descendents in one of the standardly compiled internal
-- Descendants in one of the standardly compiled internal
-- packages are normally ignored, unless the parent is also
-- in such a package (happens when Standard itself is output)
-- or if the -df switch is set which causes all links to be
@ -1941,7 +1941,7 @@ package body Treepr is
return;
end if;
-- Don't bother about a descendent in a different unit than
-- Don't bother about a descendant in a different unit than
-- the node we came from unless the -df switch is set. Note
-- that we know at this point that Sloc (D) > Standard_Location
@ -1992,7 +1992,7 @@ package body Treepr is
end if;
end;
-- Case of descendent is a list
-- Case of descendant is a list
elsif D in List_Range then
@ -2016,7 +2016,7 @@ package body Treepr is
Visit_List (List_Id (D), New_Prefix);
end if;
-- Case of descendent is an element list
-- Case of descendant is an element list
elsif D in Elist_Range then
@ -2033,15 +2033,15 @@ package body Treepr is
Visit_Elist (Elist_Id (D), New_Prefix);
end if;
-- For all other kinds of descendents (strings, names, uints etc),
-- For all other kinds of descendants (strings, names, uints etc),
-- there is nothing to visit (the contents of the field will be
-- printed when we print the containing node, but what concerns
-- us now is looking for descendents in the tree.
-- us now is looking for descendants in the tree.
else
null;
end if;
end Visit_Descendent;
end Visit_Descendant;
-- Start of processing for Visit_Node
@ -2100,44 +2100,44 @@ package body Treepr is
end if;
end if;
-- Visit all descendents of this node
-- Visit all descendants of this node
if Nkind (N) not in N_Entity then
Visit_Descendent (Field1 (N));
Visit_Descendent (Field2 (N));
Visit_Descendent (Field3 (N));
Visit_Descendent (Field4 (N));
Visit_Descendent (Field5 (N));
Visit_Descendant (Field1 (N));
Visit_Descendant (Field2 (N));
Visit_Descendant (Field3 (N));
Visit_Descendant (Field4 (N));
Visit_Descendant (Field5 (N));
if Has_Aspects (N) then
Visit_Descendent (Union_Id (Aspect_Specifications (N)));
Visit_Descendant (Union_Id (Aspect_Specifications (N)));
end if;
-- Entity case
else
Visit_Descendent (Field1 (N));
Visit_Descendent (Field3 (N));
Visit_Descendent (Field4 (N));
Visit_Descendent (Field5 (N));
Visit_Descendent (Field6 (N));
Visit_Descendent (Field7 (N));
Visit_Descendent (Field8 (N));
Visit_Descendent (Field9 (N));
Visit_Descendent (Field10 (N));
Visit_Descendent (Field11 (N));
Visit_Descendent (Field12 (N));
Visit_Descendent (Field13 (N));
Visit_Descendent (Field14 (N));
Visit_Descendent (Field15 (N));
Visit_Descendent (Field16 (N));
Visit_Descendent (Field17 (N));
Visit_Descendent (Field18 (N));
Visit_Descendent (Field19 (N));
Visit_Descendent (Field20 (N));
Visit_Descendent (Field21 (N));
Visit_Descendent (Field22 (N));
Visit_Descendent (Field23 (N));
Visit_Descendant (Field1 (N));
Visit_Descendant (Field3 (N));
Visit_Descendant (Field4 (N));
Visit_Descendant (Field5 (N));
Visit_Descendant (Field6 (N));
Visit_Descendant (Field7 (N));
Visit_Descendant (Field8 (N));
Visit_Descendant (Field9 (N));
Visit_Descendant (Field10 (N));
Visit_Descendant (Field11 (N));
Visit_Descendant (Field12 (N));
Visit_Descendant (Field13 (N));
Visit_Descendant (Field14 (N));
Visit_Descendant (Field15 (N));
Visit_Descendant (Field16 (N));
Visit_Descendant (Field17 (N));
Visit_Descendant (Field18 (N));
Visit_Descendant (Field19 (N));
Visit_Descendant (Field20 (N));
Visit_Descendant (Field21 (N));
Visit_Descendant (Field22 (N));
Visit_Descendant (Field23 (N));
-- Now an interesting special case. Normally parents are always
-- printed since we traverse the tree in a downwards direction.
@ -2146,7 +2146,7 @@ package body Treepr is
-- referenced elsewhere in the tree. The following catches this case.
if not Comes_From_Source (N) then
Visit_Descendent (Union_Id (Parent (N)));
Visit_Descendant (Union_Id (Parent (N)));
end if;
-- You may be wondering why we omitted Field2 above. The answer
@ -2171,7 +2171,7 @@ package body Treepr is
begin
Nod := N;
while Present (Nod) loop
Visit_Descendent (Union_Id (Next_Entity (Nod)));
Visit_Descendant (Union_Id (Next_Entity (Nod)));
Nod := Next_Entity (Nod);
end loop;
end;