aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2014-07-29 14:40:42 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2014-07-29 14:40:42 +0200
commit0382062b3b87859411e98bb2d3347020e7f45f48 (patch)
treea270d538296317d1c5acb6eda3c5aa21b378c4d1
parent56386ab9004a24f057aff7aeaed15da1f025f7ff (diff)
downloadgcc-0382062b3b87859411e98bb2d3347020e7f45f48.zip
gcc-0382062b3b87859411e98bb2d3347020e7f45f48.tar.gz
gcc-0382062b3b87859411e98bb2d3347020e7f45f48.tar.bz2
[multiple changes]
2014-07-29 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch7.adb (Build_BIP_Cleanup_Stmts): Remove formal parameter Obj_Id and update the comment on usage. Renamed Obj_Typ to Func_Typ and update all occurrences. (Find_Last_Init): Remove formal parameter Decl and update the comment on usage. Remove local constants Obj_Id and Obj_Typ. Remove local variables Init_Typ and Is_Conc. Remove the extraction of the initialization type. (Find_Last_Init_In_Block): Remove formal parameter Init_Typ and update the comment on usage. (Is_Init_Call): Remove formal parameter Init_Typ and update the comment on usage. Check whether the procedure call is an initialization procedure of either the object type or the initialization type. (Is_Init_Proc_Of): New routine. (Process_Object_Declaration): Obj_Id and Obj_Typ are now global to this routine. Add new variable Init_Typ. Add circuitry to extract the object type as well as the initialization type. 2014-07-29 Robert Dewar <dewar@adacore.com> * sem_case.adb: Minor reformatting. * sem_aux.ads: Minor reformatting. 2014-07-29 Ed Schonberg <schonberg@adacore.com> * sinfo.adb (Set_Else_Actions, Set_Then_Actions): Set parent pointer on these fields, even though they are semantic, because subsequent analysis and expansion of action nades may require exploring the tree, for example to locate a node to be wrapped when a function with controlled result is called. 2014-07-29 Claire Dross <dross@adacore.com> * sem_aux.adb (Get_Binary_Nkind): Use case on Name_Id instead of an intermediate string. (Get_Unary_Nkind): Use case on Name_Id instead of an intermediate string. 2014-07-29 Sergey Rybin <rybin@adacore.com frybin> * gnat_ugn.texi (gnatelim, gnatstub, gnatmetric): Add note about processing sources with preprocessor directives. From-SVN: r213155
-rw-r--r--gcc/ada/ChangeLog44
-rw-r--r--gcc/ada/exp_ch7.adb242
-rw-r--r--gcc/ada/gnat_ugn.texi18
-rw-r--r--gcc/ada/sem_aux.adb100
-rw-r--r--gcc/ada/sem_aux.ads25
-rw-r--r--gcc/ada/sem_case.adb12
-rw-r--r--gcc/ada/sinfo.adb4
-rw-r--r--gcc/ada/sinfo.ads6
8 files changed, 271 insertions, 180 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5ff2df1..7933eb7 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,47 @@
+2014-07-29 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch7.adb (Build_BIP_Cleanup_Stmts): Remove
+ formal parameter Obj_Id and update the comment on usage. Renamed
+ Obj_Typ to Func_Typ and update all occurrences.
+ (Find_Last_Init): Remove formal parameter Decl and update the comment
+ on usage.
+ Remove local constants Obj_Id and Obj_Typ. Remove local variables
+ Init_Typ and Is_Conc. Remove the extraction of the initialization type.
+ (Find_Last_Init_In_Block): Remove formal parameter
+ Init_Typ and update the comment on usage.
+ (Is_Init_Call): Remove formal parameter Init_Typ and update the comment
+ on usage. Check whether the procedure call is an initialization
+ procedure of either the object type or the initialization type.
+ (Is_Init_Proc_Of): New routine.
+ (Process_Object_Declaration): Obj_Id and Obj_Typ are now global to this
+ routine. Add new variable Init_Typ. Add circuitry to extract the object
+ type as well as the initialization type.
+
+2014-07-29 Robert Dewar <dewar@adacore.com>
+
+ * sem_case.adb: Minor reformatting.
+ * sem_aux.ads: Minor reformatting.
+
+2014-07-29 Ed Schonberg <schonberg@adacore.com>
+
+ * sinfo.adb (Set_Else_Actions, Set_Then_Actions): Set parent
+ pointer on these fields, even though they are semantic, because
+ subsequent analysis and expansion of action nades may require
+ exploring the tree, for example to locate a node to be wrapped
+ when a function with controlled result is called.
+
+2014-07-29 Claire Dross <dross@adacore.com>
+
+ * sem_aux.adb (Get_Binary_Nkind): Use case on
+ Name_Id instead of an intermediate string.
+ (Get_Unary_Nkind): Use case on Name_Id instead of an intermediate
+ string.
+
+2014-07-29 Sergey Rybin <rybin@adacore.com frybin>
+
+ * gnat_ugn.texi (gnatelim, gnatstub, gnatmetric): Add note
+ about processing sources with preprocessor directives.
+
2014-07-24 Martin Liska <mliska@suse.cz>
* gcc-interface/trans.c (finalize_nrv): Adjust function call.
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 748279b..ad7a1d2 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -2066,13 +2066,20 @@ package body Exp_Ch7 is
Has_No_Init : Boolean := False;
Is_Protected : Boolean := False)
is
- Loc : constant Source_Ptr := Sloc (Decl);
+ Loc : constant Source_Ptr := Sloc (Decl);
+ Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
- function Build_BIP_Cleanup_Stmts
- (Func_Id : Entity_Id;
- Obj_Id : Entity_Id) return Node_Id;
- -- Func_Id denotes a build-in-place function. Obj_Id is the return
- -- object of Func_Id. Generate the following cleanup code:
+ Init_Typ : Entity_Id;
+ -- The initialization type of the related object declaration. Note
+ -- that this is not necessarely the same type as Obj_Typ because of
+ -- possible type derivations.
+
+ Obj_Typ : Entity_Id;
+ -- The type of the related object declaration
+
+ function Build_BIP_Cleanup_Stmts (Func_Id : Entity_Id) return Node_Id;
+ -- Func_Id denotes a build-in-place function. Generate the following
+ -- cleanup code:
--
-- if BIPallocfrom > Secondary_Stack'Pos
-- and then BIPfinalizationmaster /= null
@@ -2090,27 +2097,25 @@ package body Exp_Ch7 is
-- allocation which Obj_Id renames.
procedure Find_Last_Init
- (Decl : Node_Id;
- Last_Init : out Node_Id;
+ (Last_Init : out Node_Id;
Body_Insert : out Node_Id);
-- Find the last initialization call related to object declaration
-- Decl. Last_Init denotes the last initialization call which follows
- -- Decl. Body_Insert denotes the finalizer body could be potentially
- -- inserted.
+ -- Decl. Body_Insert denotes a node where the finalizer body could be
+ -- potentially inserted after (if blocks are involved).
-----------------------------
-- Build_BIP_Cleanup_Stmts --
-----------------------------
function Build_BIP_Cleanup_Stmts
- (Func_Id : Entity_Id;
- Obj_Id : Entity_Id) return Node_Id
+ (Func_Id : Entity_Id) return Node_Id
is
Decls : constant List_Id := New_List;
Fin_Mas_Id : constant Entity_Id :=
Build_In_Place_Formal
(Func_Id, BIP_Finalization_Master);
- Obj_Typ : constant Entity_Id := Etype (Func_Id);
+ Func_Typ : constant Entity_Id := Etype (Func_Id);
Temp_Id : constant Entity_Id :=
Entity (Prefix (Name (Parent (Obj_Id))));
@@ -2146,7 +2151,7 @@ package body Exp_Ch7 is
-- caller's finalization master.
-- Generate:
- -- type Ptr_Typ is access Obj_Typ;
+ -- type Ptr_Typ is access Func_Typ;
Ptr_Typ := Make_Temporary (Loc, 'P');
@@ -2155,7 +2160,7 @@ package body Exp_Ch7 is
Defining_Identifier => Ptr_Typ,
Type_Definition =>
Make_Access_To_Object_Definition (Loc,
- Subtype_Indication => New_Occurrence_Of (Obj_Typ, Loc))));
+ Subtype_Indication => New_Occurrence_Of (Func_Typ, Loc))));
-- Perform minor decoration in order to set the master and the
-- storage pool attributes.
@@ -2207,8 +2212,8 @@ package body Exp_Ch7 is
-- and then BIPfinalizationmaster /= null
-- then
- if not Is_Constrained (Obj_Typ)
- or else Is_Tagged_Type (Obj_Typ)
+ if not Is_Constrained (Func_Typ)
+ or else Is_Tagged_Type (Func_Typ)
then
declare
Alloc : constant Entity_Id :=
@@ -2244,21 +2249,16 @@ package body Exp_Ch7 is
--------------------
procedure Find_Last_Init
- (Decl : Node_Id;
- Last_Init : out Node_Id;
+ (Last_Init : out Node_Id;
Body_Insert : out Node_Id)
is
- function Find_Last_Init_In_Block
- (Blk : Node_Id;
- Init_Typ : Entity_Id) return Node_Id;
+ function Find_Last_Init_In_Block (Blk : Node_Id) return Node_Id;
-- Find the last initialization call within the statements of
- -- block Blk. Init_Typ is type of the object being initialized.
+ -- block Blk.
- function Is_Init_Call
- (N : Node_Id;
- Init_Typ : Entity_Id) return Boolean;
+ function Is_Init_Call (N : Node_Id) return Boolean;
-- Determine whether node N denotes one of the initialization
- -- procedures of type Init_Typ.
+ -- procedures of types Init_Typ or Obj_Typ.
function Next_Suitable_Statement (Stmt : Node_Id) return Node_Id;
-- Given a statement which is part of a list, return the next
@@ -2268,10 +2268,7 @@ package body Exp_Ch7 is
-- Find_Last_Init_In_Block --
-----------------------------
- function Find_Last_Init_In_Block
- (Blk : Node_Id;
- Init_Typ : Entity_Id) return Node_Id
- is
+ function Find_Last_Init_In_Block (Blk : Node_Id) return Node_Id is
HSS : constant Node_Id := Handled_Statement_Sequence (Blk);
Stmt : Node_Id;
@@ -2286,9 +2283,9 @@ package body Exp_Ch7 is
-- Peek inside nested blocks in case aborts are allowed
if Nkind (Stmt) = N_Block_Statement then
- return Find_Last_Init_In_Block (Stmt, Init_Typ);
+ return Find_Last_Init_In_Block (Stmt);
- elsif Is_Init_Call (Stmt, Init_Typ) then
+ elsif Is_Init_Call (Stmt) then
return Stmt;
end if;
@@ -2303,33 +2300,38 @@ package body Exp_Ch7 is
-- Is_Init_Call --
------------------
- function Is_Init_Call
- (N : Node_Id;
- Init_Typ : Entity_Id) return Boolean
- is
- Call_Id : Entity_Id;
- Deep_Init : Entity_Id := Empty;
- Prim_Init : Entity_Id := Empty;
- Type_Init : Entity_Id := Empty;
-
- begin
- if Nkind (N) = N_Procedure_Call_Statement
- and then Nkind (Name (N)) = N_Identifier
- then
- Call_Id := Entity (Name (N));
+ function Is_Init_Call (N : Node_Id) return Boolean is
+ function Is_Init_Proc_Of
+ (Subp_Id : Entity_Id;
+ Typ : Entity_Id) return Boolean;
+ -- Determine whether subprogram Subp_Id is a valid init proc of
+ -- type Typ.
+
+ ---------------------
+ -- Is_Init_Proc_Of --
+ ---------------------
+
+ function Is_Init_Proc_Of
+ (Subp_Id : Entity_Id;
+ Typ : Entity_Id) return Boolean
+ is
+ Deep_Init : Entity_Id := Empty;
+ Prim_Init : Entity_Id := Empty;
+ Type_Init : Entity_Id := Empty;
- -- Obtain all possible initialization routines of the object
- -- type and try to match the procedure call against one of
- -- them.
+ begin
+ -- Obtain all possible initialization routines of the
+ -- related type and try to match the subprogram entity
+ -- against one of them.
-- Deep_Initialize
- Deep_Init := TSS (Init_Typ, TSS_Deep_Initialize);
+ Deep_Init := TSS (Typ, TSS_Deep_Initialize);
-- Primitive Initialize
- if Is_Controlled (Init_Typ) then
- Prim_Init := Find_Prim_Op (Init_Typ, Name_Initialize);
+ if Is_Controlled (Typ) then
+ Prim_Init := Find_Prim_Op (Typ, Name_Initialize);
if Present (Prim_Init) then
Prim_Init := Ultimate_Alias (Prim_Init);
@@ -2338,16 +2340,37 @@ package body Exp_Ch7 is
-- Type initialization routine
- if Has_Non_Null_Base_Init_Proc (Init_Typ) then
- Type_Init := Base_Init_Proc (Init_Typ);
+ if Has_Non_Null_Base_Init_Proc (Typ) then
+ Type_Init := Base_Init_Proc (Typ);
end if;
return
- (Present (Deep_Init) and then Call_Id = Deep_Init)
+ (Present (Deep_Init) and then Subp_Id = Deep_Init)
or else
- (Present (Prim_Init) and then Call_Id = Prim_Init)
+ (Present (Prim_Init) and then Subp_Id = Prim_Init)
or else
- (Present (Type_Init) and then Call_Id = Type_Init);
+ (Present (Type_Init) and then Subp_Id = Type_Init);
+ end Is_Init_Proc_Of;
+
+ -- Local variables
+
+ Call_Id : Entity_Id;
+
+ -- Start of processing for Is_Init_Call
+
+ begin
+ if Nkind (N) = N_Procedure_Call_Statement
+ and then Nkind (Name (N)) = N_Identifier
+ then
+ Call_Id := Entity (Name (N));
+
+ -- Consider both the type of the object declaration and its
+ -- related initialization type.
+
+ return
+ Is_Init_Proc_Of (Call_Id, Init_Typ)
+ or else
+ Is_Init_Proc_Of (Call_Id, Obj_Typ);
end if;
return False;
@@ -2374,13 +2397,9 @@ package body Exp_Ch7 is
-- Local variables
- Obj_Id : constant Entity_Id := Defining_Entity (Decl);
- Obj_Typ : constant Entity_Id := Base_Type (Etype (Obj_Id));
- Call : Node_Id;
- Init_Typ : Entity_Id := Obj_Typ;
- Is_Conc : Boolean := False;
- Stmt : Node_Id;
- Stmt_2 : Node_Id;
+ Call : Node_Id;
+ Stmt : Node_Id;
+ Stmt_2 : Node_Id;
-- Start of processing for Find_Last_Init
@@ -2395,34 +2414,6 @@ package body Exp_Ch7 is
return;
end if;
- -- Obtain the proper type of the object being initialized
-
- loop
- if Is_Concurrent_Type (Init_Typ)
- and then Present (Corresponding_Record_Type (Init_Typ))
- then
- Is_Conc := True;
- Init_Typ := Corresponding_Record_Type (Init_Typ);
-
- elsif Is_Private_Type (Init_Typ)
- and then Present (Full_View (Init_Typ))
- then
- Init_Typ := Full_View (Init_Typ);
-
- elsif Is_Untagged_Derivation (Init_Typ)
- and then not Is_Conc
- then
- Init_Typ := Root_Type (Init_Typ);
-
- else
- exit;
- end if;
- end loop;
-
- if Init_Typ /= Base_Type (Init_Typ) then
- Init_Typ := Base_Type (Init_Typ);
- end if;
-
Stmt := Next_Suitable_Statement (Decl);
-- A limited controlled object initialized by a function call uses
@@ -2442,7 +2433,7 @@ package body Exp_Ch7 is
-- In this scenario the declaration of the temporary acts as the
-- last initialization statement.
- if Is_Limited_Type (Init_Typ)
+ if Is_Limited_Type (Obj_Typ)
and then Has_Init_Expression (Decl)
and then No (Expression (Decl))
then
@@ -2482,7 +2473,7 @@ package body Exp_Ch7 is
-- within a block.
elsif Nkind (Stmt) = N_Block_Statement then
- Last_Init := Find_Last_Init_In_Block (Stmt, Init_Typ);
+ Last_Init := Find_Last_Init_In_Block (Stmt);
Body_Insert := Stmt;
-- Otherwise the initialization calls follow the related object
@@ -2496,14 +2487,14 @@ package body Exp_Ch7 is
if Present (Stmt_2) then
if Nkind (Stmt_2) = N_Block_Statement then
- Call := Find_Last_Init_In_Block (Stmt_2, Init_Typ);
+ Call := Find_Last_Init_In_Block (Stmt_2);
if Present (Call) then
Last_Init := Call;
Body_Insert := Stmt_2;
end if;
- elsif Is_Init_Call (Stmt_2, Init_Typ) then
+ elsif Is_Init_Call (Stmt_2) then
Last_Init := Stmt_2;
Body_Insert := Last_Init;
end if;
@@ -2511,7 +2502,7 @@ package body Exp_Ch7 is
-- If the object lacks a call to Deep_Initialize, then it must
-- have a call to its related type init proc.
- elsif Is_Init_Call (Stmt, Init_Typ) then
+ elsif Is_Init_Call (Stmt) then
Last_Init := Stmt;
Body_Insert := Last_Init;
end if;
@@ -2520,7 +2511,6 @@ package body Exp_Ch7 is
-- Local variables
- Obj_Id : constant Entity_Id := Defining_Identifier (Decl);
Body_Ins : Node_Id;
Count_Ins : Node_Id;
Fin_Call : Node_Id;
@@ -2529,23 +2519,60 @@ package body Exp_Ch7 is
Label : Node_Id;
Label_Id : Entity_Id;
Obj_Ref : Node_Id;
- Obj_Typ : Entity_Id;
-- Start of processing for Process_Object_Declaration
begin
+ -- Handle the object type and the reference to the object
+
Obj_Ref := New_Occurrence_Of (Obj_Id, Loc);
Obj_Typ := Base_Type (Etype (Obj_Id));
- -- Handle access types
+ loop
+ if Is_Access_Type (Obj_Typ) then
+ Obj_Typ := Directly_Designated_Type (Obj_Typ);
+ Obj_Ref := Make_Explicit_Dereference (Loc, Obj_Ref);
- if Is_Access_Type (Obj_Typ) then
- Obj_Ref := Make_Explicit_Dereference (Loc, Obj_Ref);
- Obj_Typ := Directly_Designated_Type (Obj_Typ);
- end if;
+ elsif Is_Concurrent_Type (Obj_Typ)
+ and then Present (Corresponding_Record_Type (Obj_Typ))
+ then
+ Obj_Typ := Corresponding_Record_Type (Obj_Typ);
+ Obj_Ref := Unchecked_Convert_To (Obj_Typ, Obj_Ref);
+
+ elsif Is_Private_Type (Obj_Typ)
+ and then Present (Full_View (Obj_Typ))
+ then
+ Obj_Typ := Full_View (Obj_Typ);
+ Obj_Ref := Unchecked_Convert_To (Obj_Typ, Obj_Ref);
+
+ elsif Obj_Typ /= Base_Type (Obj_Typ) then
+ Obj_Typ := Base_Type (Obj_Typ);
+ Obj_Ref := Unchecked_Convert_To (Obj_Typ, Obj_Ref);
+
+ else
+ exit;
+ end if;
+ end loop;
Set_Etype (Obj_Ref, Obj_Typ);
+ -- Handle the initialization type of the object declaration
+
+ Init_Typ := Obj_Typ;
+ loop
+ if Is_Private_Type (Init_Typ)
+ and then Present (Full_View (Init_Typ))
+ then
+ Init_Typ := Full_View (Init_Typ);
+
+ elsif Is_Untagged_Derivation (Init_Typ) then
+ Init_Typ := Root_Type (Init_Typ);
+
+ else
+ exit;
+ end if;
+ end loop;
+
-- Set a new value for the state counter and insert the statement
-- after the object declaration. Generate:
@@ -2571,7 +2598,7 @@ package body Exp_Ch7 is
-- either [Deep_]Initialize or the type specific init proc.
else
- Find_Last_Init (Decl, Count_Ins, Body_Ins);
+ Find_Last_Init (Count_Ins, Body_Ins);
end if;
Insert_After (Count_Ins, Inc_Decl);
@@ -2754,8 +2781,7 @@ package body Exp_Ch7 is
if Is_Build_In_Place_Function (Func_Id)
and then Needs_BIP_Finalization_Master (Func_Id)
then
- Append_To
- (Fin_Stmts, Build_BIP_Cleanup_Stmts (Func_Id, Obj_Id));
+ Append_To (Fin_Stmts, Build_BIP_Cleanup_Stmts (Func_Id));
end if;
end;
end if;
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 04633a2..062659e 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -11418,6 +11418,12 @@ After a full successful build of the main subprogram @code{gnatelim} can be
called without specifying sources to analyse, in this case it computes
the source closure of the main unit from the @file{ALI} files.
+If the set of sources to be processed by @code{gnatelim} contains sources with
+preprocessing directives
+then the needed options should be provided to run preprocessor as a part of
+the @command{gnatelim} call, and the generated set of pragmas @code{Eliminate}
+will correspond to preprocessed sources.
+
The following command will create the set of @file{ALI} files needed for
@code{gnatelim}:
@@ -15637,6 +15643,13 @@ Project Files}). Another possibility is to specify the source search
path and needed configuration files in @option{-cargs} section of @command{gnatmetric}
call, see the description of the @command{gnatmetric} switches below.
+If the set of sources to be processed by @code{gnatmetric} contains sources with
+preprocessing directives
+then the needed options should be provided to run preprocessor as a part of
+the @command{gnatmetric} call, and the computed metrics
+will correspond to preprocessed sources.
+
+
The @command{gnatmetric} command has the form
@smallexample
@@ -19373,6 +19386,11 @@ Project Files}). Another possibility is to specify the source search
path and needed configuration files in @option{-cargs} section of @command{gnatstub}
call, see the description of the @command{gnatstub} switches below.
+If the @command{gnatstub} argument source contains preprocessing directives
+then the needed options should be provided to run preprocessor as a part of
+the @command{gnatstub} call, and the generated body stub will correspond to
+the preprocessed source.
+
By default, all the program unit body stubs generated by @code{gnatstub}
raise the predefined @code{Program_Error} exception, which will catch
accidental calls of generated stubs. This behavior can be changed with
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index 0344637..4b251e3 100644
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -439,45 +439,45 @@ package body Sem_Aux is
---------------------
function Get_Binary_Nkind (Op : Entity_Id) return Node_Kind is
- Name : constant String := Get_Name_String (Chars (Op));
begin
- if Name = "Oadd" then
- return N_Op_Add;
- elsif Name = "Oconcat" then
- return N_Op_Concat;
- elsif Name = "Oexpon" then
- return N_Op_Expon;
- elsif Name = "Osubtract" then
- return N_Op_Subtract;
- elsif Name = "Omod" then
- return N_Op_Mod;
- elsif Name = "Omultiply" then
- return N_Op_Multiply;
- elsif Name = "Odivide" then
- return N_Op_Divide;
- elsif Name = "Orem" then
- return N_Op_Rem;
- elsif Name = "Oand" then
- return N_Op_And;
- elsif Name = "Oeq" then
- return N_Op_Eq;
- elsif Name = "Oge" then
- return N_Op_Ge;
- elsif Name = "Ogt" then
- return N_Op_Gt;
- elsif Name = "Ole" then
- return N_Op_Le;
- elsif Name = "Olt" then
- return N_Op_Lt;
- elsif Name = "One" then
- return N_Op_Ne;
- elsif Name = "Oxor" then
- return N_Op_Or;
- elsif Name = "Oor" then
- return N_Op_Xor;
- else
- raise Program_Error;
- end if;
+ case Chars (Op) is
+ when Name_Op_Add =>
+ return N_Op_Add;
+ when Name_Op_Concat =>
+ return N_Op_Concat;
+ when Name_Op_Expon =>
+ return N_Op_Expon;
+ when Name_Op_Subtract =>
+ return N_Op_Subtract;
+ when Name_Op_Mod =>
+ return N_Op_Mod;
+ when Name_Op_Multiply =>
+ return N_Op_Multiply;
+ when Name_Op_Divide =>
+ return N_Op_Divide;
+ when Name_Op_Rem =>
+ return N_Op_Rem;
+ when Name_Op_And =>
+ return N_Op_And;
+ when Name_Op_Eq =>
+ return N_Op_Eq;
+ when Name_Op_Ge =>
+ return N_Op_Ge;
+ when Name_Op_Gt =>
+ return N_Op_Gt;
+ when Name_Op_Le =>
+ return N_Op_Le;
+ when Name_Op_Lt =>
+ return N_Op_Lt;
+ when Name_Op_Ne =>
+ return N_Op_Ne;
+ when Name_Op_Or =>
+ return N_Op_Or;
+ when Name_Op_Xor =>
+ return N_Op_Xor;
+ when others =>
+ raise Program_Error;
+ end case;
end Get_Binary_Nkind;
------------------
@@ -652,19 +652,19 @@ package body Sem_Aux is
---------------------
function Get_Unary_Nkind (Op : Entity_Id) return Node_Kind is
- Name : constant String := Get_Name_String (Chars (Op));
begin
- if Name = "Oabs" then
- return N_Op_Abs;
- elsif Name = "Osubtract" then
- return N_Op_Minus;
- elsif Name = "Onot" then
- return N_Op_Not;
- elsif Name = "Oadd" then
- return N_Op_Plus;
- else
- raise Program_Error;
- end if;
+ case Chars (Op) is
+ when Name_Op_Abs =>
+ return N_Op_Abs;
+ when Name_Op_Subtract =>
+ return N_Op_Minus;
+ when Name_Op_Not =>
+ return N_Op_Not;
+ when Name_Op_Add =>
+ return N_Op_Plus;
+ when others =>
+ raise Program_Error;
+ end case;
end Get_Unary_Nkind;
---------------------------------
diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads
index 4eaf1bf..c40ddab 100644
--- a/gcc/ada/sem_aux.ads
+++ b/gcc/ada/sem_aux.ads
@@ -152,6 +152,18 @@ package Sem_Aux is
-- Typ must be a tagged record type. This function returns the Entity for
-- the first _Tag field in the record type.
+ function Get_Binary_Nkind (Op : Entity_Id) return Node_Kind;
+ -- Op must be an entity with an Ekind of E_Operator. This function returns
+ -- the Nkind value that would be used to construct a binary operator node
+ -- referencing this entity. It is an error to call this function if Ekind
+ -- (Op) /= E_Operator.
+
+ function Get_Unary_Nkind (Op : Entity_Id) return Node_Kind;
+ -- Op must be an entity with an Ekind of E_Operator. This function returns
+ -- the Nkind value that would be used to construct a unary operator node
+ -- referencing this entity. It is an error to call this function if Ekind
+ -- (Op) /= E_Operator.
+
function Get_Rep_Item
(E : Entity_Id;
Nam : Name_Id;
@@ -386,17 +398,4 @@ package Sem_Aux is
-- package specification. Simplifies handling of child units, and better
-- than the old idiom: Specification (Unit_Declaration_Node (Pack_Id)).
- function Get_Binary_Nkind (Op : Entity_Id) return Node_Kind;
- -- Op must be an entity with an Ekind of E_Operator.
- -- This function returns the Nkind value that would
- -- be used to construct a binary operator node referencing
- -- this entity. It is an error to call this function
- -- if Ekind (Op) /= E_Operator.
-
- function Get_Unary_Nkind (Op : Entity_Id) return Node_Kind;
- -- Op must be an entity with an Ekind of E_Operator.
- -- This function returns the Nkind value that would
- -- be used to construct a unary operator node referencing
- -- this entity. It is an error to call this function
- -- if Ekind (Op) /= E_Operator.
end Sem_Aux;
diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb
index fc7dc44..7a8a60a 100644
--- a/gcc/ada/sem_case.adb
+++ b/gcc/ada/sem_case.adb
@@ -647,7 +647,7 @@ package body Sem_Case is
Bounds_Lo : constant Node_Id := Type_Low_Bound (Bounds_Type);
Num_Choices : constant Nat := Choice_Table'Last;
Has_Predicate : constant Boolean :=
- Is_Static_Subtype (Bounds_Type)
+ Is_OK_Static_Subtype (Bounds_Type)
and then Present (Static_Predicate (Bounds_Type));
Choice : Node_Id;
@@ -977,7 +977,7 @@ package body Sem_Case is
-- Special case: only an others case is present. The others case
-- covers the full range of the type.
- if Is_Static_Subtype (Choice_Type) then
+ if Is_OK_Static_Subtype (Choice_Type) then
Choice := New_Occurrence_Of (Choice_Type, Loc);
else
Choice := New_Occurrence_Of (Base_Type (Choice_Type), Loc);
@@ -1268,9 +1268,9 @@ package body Sem_Case is
-- Do not insert non static choices in the table to be sorted
- elsif not Is_Static_Expression (Lo)
+ elsif not Is_OK_Static_Expression (Lo)
or else
- not Is_Static_Expression (Hi)
+ not Is_OK_Static_Expression (Hi)
then
Process_Non_Static_Choice (Choice);
return;
@@ -1498,7 +1498,7 @@ package body Sem_Case is
-- Not predicated subtype case
- elsif not Is_Static_Subtype (E) then
+ elsif not Is_OK_Static_Subtype (E) then
Process_Non_Static_Choice (Choice);
else
Check
@@ -1522,7 +1522,7 @@ package body Sem_Case is
begin
E := Entity (Subtype_Mark (Choice));
- if not Is_Static_Subtype (E) then
+ if not Is_OK_Static_Subtype (E) then
Process_Non_Static_Choice (Choice);
else
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index ec7a23f..2d21669 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -4238,7 +4238,7 @@ package body Sinfo is
begin
pragma Assert (False
or else NT (N).Nkind = N_If_Expression);
- Set_List3 (N, Val); -- semantic field, no parent set
+ Set_List3_With_Parent (N, Val); -- semantic field, but needs parents
end Set_Else_Actions;
procedure Set_Else_Statements
@@ -6266,7 +6266,7 @@ package body Sinfo is
begin
pragma Assert (False
or else NT (N).Nkind = N_If_Expression);
- Set_List2 (N, Val); -- semantic field, no parent set
+ Set_List2_With_Parent (N, Val); -- semantic field, but needs parents
end Set_Then_Actions;
procedure Set_Then_Statements
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 86d95305..36bd33f 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -4262,7 +4262,11 @@ package Sinfo is
-- Note: the Then_Actions and Else_Actions fields are always set to
-- No_List in the tree passed to Gigi. These fields are used only
- -- for temporary processing purposes in the expander.
+ -- for temporary processing purposes in the expander. Even though they
+ -- are semantic fields, their parent pointers are set because analysis
+ -- of actions nodes in those lists may generate additional actions that
+ -- need to know their insertion point (for example for the creation of
+ -- transient scopes).
----------------------------
-- 4.5.7 Case Expression --