From d9d25d048f004727e491c4887a4b1460afff1c24 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 18 Apr 2016 11:20:56 +0200 Subject: [PATCH] [multiple changes] 2016-04-18 Arnaud Charlet * sem_prag.adb (Process_Convention): Relax rule on exporting Intrinsic types if Relaxed_RM_Semantics is True. 2016-04-18 Vincent Celier * 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 * sem_type.adb (Operator_Matches_Spec): Call First_Formal on New_S only once at the beginning of the function. From-SVN: r235100 --- gcc/ada/ChangeLog | 19 ++++++++++ gcc/ada/atree.adb | 10 +++--- gcc/ada/atree.ads | 16 ++++----- gcc/ada/checks.ads | 2 +- gcc/ada/einfo.adb | 24 +++++++------ gcc/ada/einfo.ads | 14 ++++---- gcc/ada/errout.ads | 2 +- gcc/ada/exp_ch3.ads | 4 +-- gcc/ada/exp_ch4.adb | 6 ++-- gcc/ada/exp_unst.adb | 2 +- gcc/ada/lib.ads | 2 +- gcc/ada/par.adb | 6 ++-- gcc/ada/sem.adb | 4 +-- gcc/ada/sem_attr.adb | 2 +- gcc/ada/sem_ch10.adb | 2 +- gcc/ada/sem_ch12.adb | 2 +- gcc/ada/sem_ch3.adb | 16 ++++----- gcc/ada/sem_ch4.adb | 26 +++++++------- gcc/ada/sem_prag.adb | 8 +++-- gcc/ada/sem_res.adb | 2 +- gcc/ada/sem_type.adb | 23 ++++++------ gcc/ada/sem_util.adb | 28 +++++++-------- gcc/ada/sem_util.ads | 18 +++++----- gcc/ada/sem_warn.adb | 2 +- gcc/ada/sinfo.ads | 2 +- gcc/ada/treepr.adb | 100 +++++++++++++++++++++++++-------------------------- 26 files changed, 184 insertions(+), 158 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6f84ab3..465294b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2016-04-18 Arnaud Charlet + + * sem_prag.adb (Process_Convention): Relax rule on exporting + Intrinsic types if Relaxed_RM_Semantics is True. + +2016-04-18 Vincent Celier + + * 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 + + * 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 * gcc-interface/decl.c (components_to_record): Restrict the previous diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 5ae768a..97f014e 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -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 diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 0f5b512..8d02bb7 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -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). -- diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads index 9883c83..2d7d203 100644 --- a/gcc/ada/checks.ads +++ b/gcc/ada/checks.ads @@ -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. -- diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index b252e8c..a43bff5 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -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)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index cd5a4fb..deae1b9 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -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); diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 4540c93..7066914 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -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. diff --git a/gcc/ada/exp_ch3.ads b/gcc/ada/exp_ch3.ads index 3f2db94..e42fc82 100644 --- a/gcc/ada/exp_ch3.ads +++ b/gcc/ada/exp_ch3.ads @@ -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 diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index eff75c2..125fa12 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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); diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index 93fbf6c..d705308 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -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; diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index 4e9471c..50825a8 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -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 diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index 7c380840..f720b69d 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -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; diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 819bcd5..f6f4a91 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -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))); diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index f0bb4cf..717a4b1 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -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 diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index b6116af..022edfe 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -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 diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 8fdd700..b6256e1 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -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 diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 35d2b98..5f28a14 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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 diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 94ecc23..d84ef66 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -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 diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 3c8b6a5..8cafd56d 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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 diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index f551c5e..8eb8ac0 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index f00639e..de8dbfb 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -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) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index cc4a4fc..f100a07 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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 diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index b37402a..d8a9b52 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -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 diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 3b3bc2b..18b4e91 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -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; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 4ef11a3..c82bdec 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -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. ------------------------ diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb index a032416..9933cf7 100644 --- a/gcc/ada/treepr.adb +++ b/gcc/ada/treepr.adb @@ -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; -- 2.7.4