[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

gcc/ada/ChangeLog

+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.

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;

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

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

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;

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

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

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