2016-07-06 Arnaud Charlet <charlet@adacore.com>

	* lib.adb (Check_Same_Extended_Unit): Complete previous change.
	* sem_intr.adb (Errint): New parameter Relaxed. Refine previous
	change to only disable errors selectively.
	* sem_util.adb: minor style fix in object declaration

2016-07-06  Yannick Moy  <moy@adacore.com>

	* sem_warn.adb (Check_Infinite_Loop_Warning.Find_Var): Special case a
	call to a volatile function, so that it does not lead to a warning in
	that case.

2016-07-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch12.adb, sem_ch4.adb, sem_ch6.adb: Minor reformatting.

2016-07-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* gnat1drv.adb: Code clean up. Do not emit any
	code generation errors when the unit is ignored Ghost.

2016-07-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_eval.adb (Check_Non_Static_Context): If the expression
	is a real literal of a floating point type that is part of a
	larger expression and is not a static expression, transform it
	into a machine number now so that the rest of the computation,
	even if other components are static, is not evaluated with
	extra precision.

2016-07-06  Javier Miranda  <miranda@adacore.com>

	* sem_ch13.adb (Freeze_Entity_Checks): Undo previous patch and move the
	needed functionality to Analyze_Freeze_Generic_Entity.
	(Analyze_Freeze_Generic_Entity): If the entity is not already frozen
	and has delayed aspects then analyze them.

2016-07-06  Yannick Moy  <moy@adacore.com>

	* sem_prag.adb (Analyze_Pragma.Process_Inline.Set_Inline_Flags):
	Special case for unanalyzed body entity of ghost expression function.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@238050 138bc75d-0d04-0410-961f-82ee72b054a4

12 files changed, 224 insertions, 125 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8e8a370d0a1..8f060caf8ab 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,46 @@
+2016-07-06  Arnaud Charlet  <charlet@adacore.com>
+
+	* lib.adb (Check_Same_Extended_Unit): Complete previous change.
+	* sem_intr.adb (Errint): New parameter Relaxed. Refine previous
+	change to only disable errors selectively.
+	* sem_util.adb: minor style fix in object declaration
+
+2016-07-06  Yannick Moy  <moy@adacore.com>
+
+	* sem_warn.adb (Check_Infinite_Loop_Warning.Find_Var): Special case a
+	call to a volatile function, so that it does not lead to a warning in
+	that case.
+
+2016-07-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch12.adb, sem_ch4.adb, sem_ch6.adb: Minor reformatting.
+
+2016-07-06  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* gnat1drv.adb: Code clean up. Do not emit any
+	code generation errors when the unit is ignored Ghost.
+
+2016-07-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_eval.adb (Check_Non_Static_Context): If the expression
+	is a real literal of a floating point type that is part of a
+	larger expression and is not a static expression, transform it
+	into a machine number now so that the rest of the computation,
+	even if other components are static, is not evaluated with
+	extra precision.
+
+2016-07-06  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch13.adb (Freeze_Entity_Checks): Undo previous patch and move the
+	needed functionality to Analyze_Freeze_Generic_Entity.
+	(Analyze_Freeze_Generic_Entity): If the entity is not already frozen
+	and has delayed aspects then analyze them.
+
+2016-07-06  Yannick Moy  <moy@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma.Process_Inline.Set_Inline_Flags):
+	Special case for unanalyzed body entity of ghost expression function.
+
 2016-07-06  Javier Miranda  <miranda@adacore.com>
 
 	* sem_ch7.adb (Analyze_Package_Specification): Insert its
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 2ade204e6ab..acb79a56980 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -89,15 +89,6 @@ with System.OS_Lib;
 --------------
 
 procedure Gnat1drv is
-   Main_Unit_Node : Node_Id;
-   --  Compilation unit node for main unit
-
-   Main_Kind : Node_Kind;
-   --  Kind of main compilation unit node
-
-   Back_End_Mode : Back_End.Back_End_Mode_Type;
-   --  Record back-end mode
-
    procedure Adjust_Global_Switches;
    --  There are various interactions between front-end switch settings,
    --  including debug switch settings and target dependent parameters.
@@ -105,8 +96,9 @@ procedure Gnat1drv is
    --  We do it after scanning out all the switches, so that we are not
    --  depending on the order in which switches appear.
 
-   procedure Check_Bad_Body;
-   --  Called to check if the unit we are compiling has a bad body
+   procedure Check_Bad_Body (Unit_Node : Node_Id; Unit_Kind : Node_Kind);
+   --  Called to check whether a unit described by its compilation unit node
+   --  and kind has a bad body.
 
    procedure Check_Rep_Info;
    --  Called when we are not generating code, to check if -gnatR was requested
@@ -712,10 +704,8 @@ procedure Gnat1drv is
    -- Check_Bad_Body --
    --------------------
 
-   procedure Check_Bad_Body is
-      Sname   : Unit_Name_Type;
-      Src_Ind : Source_File_Index;
-      Fname   : File_Name_Type;
+   procedure Check_Bad_Body (Unit_Node : Node_Id; Unit_Kind : Node_Kind) is
+      Fname : File_Name_Type;
 
       procedure Bad_Body_Error (Msg : String);
       --  Issue message for bad body found
@@ -726,11 +716,16 @@ procedure Gnat1drv is
 
       procedure Bad_Body_Error (Msg : String) is
       begin
-         Error_Msg_N (Msg, Main_Unit_Node);
+         Error_Msg_N (Msg, Unit_Node);
          Error_Msg_File_1 := Fname;
-         Error_Msg_N ("remove incorrect body in file{!", Main_Unit_Node);
+         Error_Msg_N ("remove incorrect body in file{!", Unit_Node);
       end Bad_Body_Error;
 
+      --  Local variables
+
+      Sname   : Unit_Name_Type;
+      Src_Ind : Source_File_Index;
+
    --  Start of processing for Check_Bad_Body
 
    begin
@@ -743,13 +738,13 @@ procedure Gnat1drv is
 
       --  Check for body not allowed
 
-      if (Main_Kind = N_Package_Declaration
-           and then not Body_Required (Main_Unit_Node))
-        or else (Main_Kind = N_Generic_Package_Declaration
-                  and then not Body_Required (Main_Unit_Node))
-        or else Main_Kind = N_Package_Renaming_Declaration
-        or else Main_Kind = N_Subprogram_Renaming_Declaration
-        or else Nkind (Original_Node (Unit (Main_Unit_Node)))
+      if (Unit_Kind = N_Package_Declaration
+           and then not Body_Required (Unit_Node))
+        or else (Unit_Kind = N_Generic_Package_Declaration
+                  and then not Body_Required (Unit_Node))
+        or else Unit_Kind = N_Package_Renaming_Declaration
+        or else Unit_Kind = N_Subprogram_Renaming_Declaration
+        or else Nkind (Original_Node (Unit (Unit_Node)))
                          in N_Generic_Instantiation
       then
          Sname := Unit_Name (Main_Unit);
@@ -793,16 +788,16 @@ procedure Gnat1drv is
             --  be incorrect (we may have misinterpreted a junk spec as not
             --  needing a body when it really does).
 
-            if Main_Kind = N_Package_Declaration
+            if Unit_Kind = N_Package_Declaration
               and then Ada_Version = Ada_83
               and then Operating_Mode = Generate_Code
               and then Distribution_Stub_Mode /= Generate_Caller_Stub_Body
               and then not Compilation_Errors
             then
                Error_Msg_N
-                 ("package $$ does not require a body??", Main_Unit_Node);
+                 ("package $$ does not require a body??", Unit_Node);
                Error_Msg_File_1 := Fname;
-               Error_Msg_N ("body in file{ will be ignored??", Main_Unit_Node);
+               Error_Msg_N ("body in file{ will be ignored??", Unit_Node);
 
                --  Ada 95 cases of a body file present when no body is
                --  permitted. This we consider to be an error.
@@ -810,15 +805,15 @@ procedure Gnat1drv is
             else
                --  For generic instantiations, we never allow a body
 
-               if Nkind (Original_Node (Unit (Main_Unit_Node))) in
+               if Nkind (Original_Node (Unit (Unit_Node))) in
                                                     N_Generic_Instantiation
                then
                   Bad_Body_Error
                     ("generic instantiation for $$ does not allow a body");
 
-                  --  A library unit that is a renaming never allows a body
+               --  A library unit that is a renaming never allows a body
 
-               elsif Main_Kind in N_Renaming_Declaration then
+               elsif Unit_Kind in N_Renaming_Declaration then
                   Bad_Body_Error
                     ("renaming declaration for $$ does not allow a body!");
 
@@ -829,11 +824,11 @@ procedure Gnat1drv is
                   --  body when in fact it does.
 
                elsif not Compilation_Errors then
-                  if Main_Kind = N_Package_Declaration then
+                  if Unit_Kind = N_Package_Declaration then
                      Bad_Body_Error
                        ("package $$ does not allow a body!");
 
-                  elsif Main_Kind = N_Generic_Package_Declaration then
+                  elsif Unit_Kind = N_Generic_Package_Declaration then
                      Bad_Body_Error
                        ("generic package $$ does not allow a body!");
                   end if;
@@ -893,9 +888,18 @@ procedure Gnat1drv is
       if AAMP_On_Target then
          Sem_Ch13.Validate_Independence;
       end if;
-
    end Post_Compilation_Validation_Checks;
 
+   --  Local variables
+
+   Back_End_Mode : Back_End.Back_End_Mode_Type;
+
+   Main_Unit_Kind : Node_Kind;
+   --  Kind of main compilation unit node
+
+   Main_Unit_Node : Node_Id;
+   --  Compilation unit node for main unit
+
 --  Start of processing for Gnat1drv
 
 begin
@@ -1065,8 +1069,9 @@ begin
       end if;
 
       Main_Unit_Node := Cunit (Main_Unit);
-      Main_Kind := Nkind (Unit (Main_Unit_Node));
-      Check_Bad_Body;
+      Main_Unit_Kind := Nkind (Unit (Main_Unit_Node));
+
+      Check_Bad_Body (Main_Unit_Node, Main_Unit_Kind);
 
       --  In CodePeer mode we always delete old SCIL files before regenerating
       --  new ones, in case of e.g. errors, and also to remove obsolete scilx
@@ -1159,21 +1164,23 @@ begin
       --  subunits. Note that we always generate code for all generic units (a
       --  change from some previous versions of GNAT).
 
-      elsif Main_Kind = N_Subprogram_Body and then not Subunits_Missing then
+      elsif Main_Unit_Kind = N_Subprogram_Body
+        and then not Subunits_Missing
+      then
          Back_End_Mode := Generate_Object;
 
       --  We can generate code for a package body unless there are subunits
       --  missing (note that we always generate code for generic units, which
       --  is a change from some earlier versions of GNAT).
 
-      elsif Main_Kind = N_Package_Body and then not Subunits_Missing then
+      elsif Main_Unit_Kind = N_Package_Body and then not Subunits_Missing then
          Back_End_Mode := Generate_Object;
 
       --  We can generate code for a package declaration or a subprogram
       --  declaration only if it does not required a body.
 
-      elsif Nkind_In (Main_Kind, N_Package_Declaration,
-                                 N_Subprogram_Declaration)
+      elsif Nkind_In (Main_Unit_Kind, N_Package_Declaration,
+                                      N_Subprogram_Declaration)
         and then
           (not Body_Required (Main_Unit_Node)
              or else Distribution_Stub_Mode = Generate_Caller_Stub_Body)
@@ -1183,8 +1190,8 @@ begin
       --  We can generate code for a generic package declaration of a generic
       --  subprogram declaration only if does not require a body.
 
-      elsif Nkind_In (Main_Kind, N_Generic_Package_Declaration,
-                                 N_Generic_Subprogram_Declaration)
+      elsif Nkind_In (Main_Unit_Kind, N_Generic_Package_Declaration,
+                                      N_Generic_Subprogram_Declaration)
         and then not Body_Required (Main_Unit_Node)
       then
          Back_End_Mode := Generate_Object;
@@ -1192,15 +1199,15 @@ begin
       --  Compilation units that are renamings do not require bodies, so we can
       --  generate code for them.
 
-      elsif Nkind_In (Main_Kind, N_Package_Renaming_Declaration,
-                                 N_Subprogram_Renaming_Declaration)
+      elsif Nkind_In (Main_Unit_Kind, N_Package_Renaming_Declaration,
+                                      N_Subprogram_Renaming_Declaration)
       then
          Back_End_Mode := Generate_Object;
 
       --  Compilation units that are generic renamings do not require bodies
       --  so we can generate code for them.
 
-      elsif Main_Kind in N_Generic_Renaming_Declaration then
+      elsif Main_Unit_Kind in N_Generic_Renaming_Declaration then
          Back_End_Mode := Generate_Object;
 
       --  It is not an error to analyze in CodePeer mode a spec which requires
@@ -1240,45 +1247,61 @@ begin
       --  generate code).
 
       if Back_End_Mode = Skip then
-         Set_Standard_Error;
-         Write_Str ("cannot generate code for file ");
-         Write_Name (Unit_File_Name (Main_Unit));
 
-         if Subunits_Missing then
-            Write_Str (" (missing subunits)");
-            Write_Eol;
+         --  An ignored Ghost unit is rewritten into a null statement because
+         --  it must not produce an ALI or object file. Do not emit any errors
+         --  related to code generation because the unit does not exist.
 
-            --  Force generation of ALI file, for backward compatibility
+         if Main_Unit_Kind = N_Null_Statement
+           and then Is_Ignored_Ghost_Node
+                      (Original_Node (Unit (Main_Unit_Node)))
+         then
+            null;
 
-            Opt.Force_ALI_Tree_File := True;
+         --  Otherwise the unit is missing a crucial piece that prevents code
+         --  generation.
 
-         elsif Main_Kind = N_Subunit then
-            Write_Str (" (subunit)");
-            Write_Eol;
+         else
+            Set_Standard_Error;
+            Write_Str ("cannot generate code for file ");
+            Write_Name (Unit_File_Name (Main_Unit));
 
-            --  Force generation of ALI file, for backward compatibility
+            if Subunits_Missing then
+               Write_Str (" (missing subunits)");
+               Write_Eol;
 
-            Opt.Force_ALI_Tree_File := True;
+               --  Force generation of ALI file, for backward compatibility
 
-         elsif Main_Kind = N_Subprogram_Declaration then
-            Write_Str (" (subprogram spec)");
-            Write_Eol;
+               Opt.Force_ALI_Tree_File := True;
 
-         --  Generic package body in GNAT implementation mode
+            elsif Main_Unit_Kind = N_Subunit then
+               Write_Str (" (subunit)");
+               Write_Eol;
 
-         elsif Main_Kind = N_Package_Body and then GNAT_Mode then
-            Write_Str (" (predefined generic)");
-            Write_Eol;
+               --  Force generation of ALI file, for backward compatibility
 
-            --  Force generation of ALI file, for backward compatibility
+               Opt.Force_ALI_Tree_File := True;
 
-            Opt.Force_ALI_Tree_File := True;
+            elsif Main_Unit_Kind = N_Subprogram_Declaration then
+               Write_Str (" (subprogram spec)");
+               Write_Eol;
 
-         --  Only other case is a package spec
+            --  Generic package body in GNAT implementation mode
 
-         else
-            Write_Str (" (package spec)");
-            Write_Eol;
+            elsif Main_Unit_Kind = N_Package_Body and then GNAT_Mode then
+               Write_Str (" (predefined generic)");
+               Write_Eol;
+
+               --  Force generation of ALI file, for backward compatibility
+
+               Opt.Force_ALI_Tree_File := True;
+
+            --  Only other case is a package spec
+
+            else
+               Write_Str (" (package spec)");
+               Write_Eol;
+            end if;
          end if;
 
          Set_Standard_Output;
@@ -1320,7 +1343,7 @@ begin
       if Back_End_Mode = Declarations_Only
         and then
           (not (Back_Annotate_Rep_Info or Generate_SCIL or GNATprove_Mode)
-            or else Main_Kind = N_Subunit
+            or else Main_Unit_Kind = N_Subunit
             or else Frontend_Layout_On_Target
             or else ASIS_GNSA_Mode)
       then
@@ -1465,11 +1488,10 @@ begin
       when Program_Error =>
          Comperr.Compiler_Abort ("Program_Error");
 
-      when Storage_Error =>
-
-         --  Assume this is a bug. If it is real, the message will in any case
-         --  say Storage_Error, giving a strong hint.
+      --  Assume this is a bug. If it is real, the message will in any case
+      --  say Storage_Error, giving a strong hint.
 
+      when Storage_Error =>
          Comperr.Compiler_Abort ("Storage_Error");
 
       when Unrecoverable_Error =>
@@ -1482,7 +1504,7 @@ begin
    <<End_Of_Program>>
    null;
 
-   --  The outer exception handles an unrecoverable error
+--  The outer exception handler handles an unrecoverable error
 
 exception
    when Unrecoverable_Error =>
diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb
index c4edc7f1ebb..0ba9f9ad245 100644
--- a/gcc/ada/lib.adb
+++ b/gcc/ada/lib.adb
@@ -445,7 +445,14 @@ package body Lib is
          --  Prevent looping forever
 
          if Counter > Max_Iterations then
-            raise Program_Error;
+            --  ??? Not quite right, but return a value to be able to generate
+            --  SCIL files and hope for the best.
+
+            if CodePeer_Mode then
+               return No;
+            else
+               raise Program_Error;
+            end if;
          end if;
       end loop;
    end Check_Same_Extended_Unit;
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index d79a8453ada..aecf7d4355d 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -14879,8 +14879,8 @@ package body Sem_Ch12 is
                     and then Is_Global (Entity (Orig_N2_Parent))
                   then
                      N2 := Aux_N2;
-                     Set_Associated_Node (Parent (N),
-                       Original_Node (Parent (N2)));
+                     Set_Associated_Node
+                       (Parent (N), Original_Node (Parent (N2)));
 
                   --  Common case
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index aad9f68fe96..89a17c8755f 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -6618,7 +6618,13 @@ package body Sem_Ch13 is
    -----------------------------------
 
    procedure Analyze_Freeze_Generic_Entity (N : Node_Id) is
+      E : constant Entity_Id := Entity (N);
+
    begin
+      if not Is_Frozen (E) and then Has_Delayed_Aspects (E) then
+         Analyze_Aspects_At_Freeze_Point (E);
+      end if;
+
       Freeze_Entity_Checks (N);
    end Analyze_Freeze_Generic_Entity;
 
@@ -10789,20 +10795,10 @@ package body Sem_Ch13 is
       --  the subtype name in the saved expression so that they will not cause
       --  trouble in the preanalysis.
 
-      --  Case 1: Generic case. For freezing nodes of types defined in generics
-      --  we must perform the analysis of its aspects; needed to ensure that
-      --  they have the minimum decoration needed by ASIS.
-
-      if not Non_Generic_Case then
-         if Has_Delayed_Aspects (E) then
-            Push_Scope (Scope (E));
-            Analyze_Aspects_At_Freeze_Point (E);
-            Pop_Scope;
-         end if;
-
-      --  Case 2: Non-generic case
+      --  This is also not needed in the generic case
 
-      elsif Has_Delayed_Aspects (E)
+      if Non_Generic_Case
+        and then Has_Delayed_Aspects (E)
         and then Scope (E) = Current_Scope
       then
          --  Retrieve the visibility to the discriminants in order to properly
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 5bbc1a34d17..45ad8d63a11 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3495,11 +3495,11 @@ package body Sem_Ch4 is
                --      generic
                --         type Inner_T is private;
                --         with function Func (Formal : Inner_T)   --  (1)
-               --                            return ... is <>;
+               --           return ... is <>;
 
                --      package Inner_Gen is
                --         function Inner_Func (Formal : Inner_T)  --  (2)
-               --                             return ... is (Func (Formal));
+               --           return ... is (Func (Formal));
                --      end Inner_Gen;
                --   end Outer_Generic;
 
@@ -3509,15 +3509,15 @@ package body Sem_Ch4 is
                --  In the example above, the type of parameter
                --  Inner_Func.Formal at (2) is incompatible with the type of
                --  Func.Formal at (1) in the context of instantiations
-               --  Outer_Inst and Inner_Inst. In reality both types are
-               --  generic actual subtypes renaming base type Actual_T as
-               --  part of the generic prologues for the instantiations.
-
-               --  Recognize this case and add a type conversion to allow
-               --  this kind of generic actual subtype conformance. Note that
-               --  this is done only when the call is non-overloaded because
-               --  the resolution mechanism already has the means to
-               --  disambiguate similar cases.
+               --  Outer_Inst and Inner_Inst. In reality both types are generic
+               --  actual subtypes renaming base type Actual_T as part of the
+               --  generic prologues for the instantiations.
+
+               --  Recognize this case and add a type conversion to allow this
+               --  kind of generic actual subtype conformance. Note that this
+               --  is done only when the call is non-overloaded because the
+               --  resolution mechanism already has the means to disambiguate
+               --  similar cases.
 
                elsif not Is_Overloaded (Name (N))
                  and then Is_Type (Etype (Actual))
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index a91d62e5ce9..86083eb6955 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2143,17 +2143,18 @@ package body Sem_Ch6 is
    --  the subprogram, or to perform conformance checks.
 
    procedure Analyze_Subprogram_Body_Helper (N : Node_Id) is
-      Loc          : constant Source_Ptr := Sloc (N);
-      Body_Spec    : Node_Id             := Specification (N);
-      Body_Id      : Entity_Id           := Defining_Entity (Body_Spec);
-      Prev_Id      : constant Entity_Id  := Current_Entity_In_Scope (Body_Id);
-      Exch_Views   : Elist_Id            := No_Elist;
-      Desig_View   : Entity_Id           := Empty;
-      Conformant   : Boolean;
-      HSS          : Node_Id;
-      Prot_Typ     : Entity_Id := Empty;
-      Spec_Id      : Entity_Id;
-      Spec_Decl    : Node_Id   := Empty;
+      Body_Spec : Node_Id             := Specification (N);
+      Body_Id   : Entity_Id           := Defining_Entity (Body_Spec);
+      Loc       : constant Source_Ptr := Sloc (N);
+      Prev_Id   : constant Entity_Id  := Current_Entity_In_Scope (Body_Id);
+
+      Conformant : Boolean;
+      Desig_View : Entity_Id := Empty;
+      Exch_Views : Elist_Id  := No_Elist;
+      HSS        : Node_Id;
+      Prot_Typ   : Entity_Id := Empty;
+      Spec_Decl  : Node_Id   := Empty;
+      Spec_Id    : Entity_Id;
 
       Last_Real_Spec_Entity : Entity_Id := Empty;
       --  When we analyze a separate spec, the entity chain ends up containing
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 6ce93639b89..314c110fb8d 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -445,11 +445,24 @@ package body Sem_Eval is
       --  that an infinity will result.
 
       if not Is_Static_Expression (N) then
-         if Is_Floating_Point_Type (T)
-           and then Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True)
-         then
-            Error_Msg_N
-              ("??float value out of range, infinity will be generated", N);
+         if Is_Floating_Point_Type (T) then
+            if Is_Out_Of_Range (N, Base_Type (T), Assume_Valid => True) then
+               Error_Msg_N
+                 ("??float value out of range, infinity will be generated", N);
+
+            --  The literal may be the result of constant-folding of a non-
+            --  static subexpression of a larger expression (e.g. a conversion
+            --  of a non-static variable whose value happens to be known). At
+            --  this point we must reduce the value of the subexpression to a
+            --  machine number (RM 4.9 (38/2)).
+
+            elsif Nkind (N) = N_Real_Literal
+              and then Nkind (Parent (N)) in N_Subexpr
+            then
+               Rewrite (N, New_Copy (N));
+               Set_Realval
+                 (N, Machine (Base_Type (T), Realval (N), Round_Even, N));
+            end if;
          end if;
 
          return;
diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb
index e26443aa980..c038dc4d799 100644
--- a/gcc/ada/sem_intr.adb
+++ b/gcc/ada/sem_intr.adb
@@ -62,11 +62,14 @@ package body Sem_Intr is
    --  as for Check_Intrinsic_Subprogram (i.e. the entity of the subprogram
    --  declaration, and the node for the pragma argument, used for messages).
 
-   procedure Errint (Msg : String; S : Node_Id; N : Node_Id);
+   procedure Errint
+     (Msg : String; S : Node_Id; N : Node_Id; Relaxed : Boolean := False);
    --  Post error message for bad intrinsic, the message itself is posted
    --  on the appropriate spec node and another message is placed on the
    --  pragma itself, referring to the spec. S is the node in the spec on
    --  which the message is to be placed, and N is the pragma argument node.
+   --  Relaxed is True if the message should not be emitted in
+   --  Relaxed_RM_Semantics mode.
 
    ------------------------------
    -- Check_Exception_Function --
@@ -432,7 +435,7 @@ package body Sem_Intr is
       then
          Errint
            ("first argument for shift must have size 8, 16, 32 or 64",
-            Ptyp1, N);
+            Ptyp1, N, Relaxed => True);
          return;
 
       elsif Non_Binary_Modulus (Typ1) then
@@ -450,7 +453,7 @@ package body Sem_Intr is
       then
          Errint
            ("modular type for shift must have modulus of 2'*'*8, "
-            & "2'*'*16, 2'*'*32, or 2'*'*64", Ptyp1, N);
+            & "2'*'*16, 2'*'*32, or 2'*'*64", Ptyp1, N, Relaxed => True);
 
       elsif Etype (Arg1) /= Etype (E) then
          Errint
@@ -465,12 +468,13 @@ package body Sem_Intr is
    -- Errint --
    ------------
 
-   procedure Errint (Msg : String; S : Node_Id; N : Node_Id) is
+   procedure Errint
+     (Msg : String; S : Node_Id; N : Node_Id; Relaxed : Boolean := False) is
    begin
       --  Ignore errors on Intrinsic in Relaxed_RM_Semantics mode where we can
       --  be more liberal.
 
-      if not Relaxed_RM_Semantics then
+      if not (Relaxed and Relaxed_RM_Semantics) then
          Error_Msg_N (Msg, S);
          Error_Msg_N ("incorrect intrinsic subprogram, see spec", N);
       end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index f603e317af4..3b9d9841f47 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -9080,6 +9080,14 @@ package body Sem_Prag is
                   Ghost_Id := Subp;
                end if;
 
+            --  Do not issue an error on an unanalyzed subprogram body entity.
+            --  It may lead to spurious errors on unanalyzed body entities of
+            --  expression functions, which are not yet marked as ghost, yet
+            --  identified as the Corresponding_Body of the ghost declaration.
+
+            elsif Ekind (Subp) = E_Void then
+               null;
+
             --  Otherwise the subprogram is non-Ghost. It is illegal to mix
             --  references to Ghost and non-Ghost entities (SPARK RM 6.9).
 
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index fd6421cad57..e8a22fa64e1 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -11500,7 +11500,7 @@ package body Sem_Util is
    ------------------------------------------
 
    procedure Inspect_Deferred_Constant_Completion (Decls : List_Id) is
-      Decl   : Node_Id;
+      Decl : Node_Id;
 
    begin
       Decl := First (Decls);
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index cb0a09293aa..d9050959ff2 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -314,6 +314,11 @@ package body Sem_Warn is
             elsif Is_Suspicious_Function_Name (Entity (Name (N))) then
                return;
 
+            --  Forget it if function is marked Volatile_Function
+
+            elsif Is_Volatile_Function (Entity (Name (N))) then
+               return;
+
             --  Forget it if warnings are suppressed on function entity
 
             elsif Has_Warnings_Off (Entity (Name (N))) then