From d030f3a45173ca7496c50d47e651638e3ff2f00f Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 6 Jul 2016 15:38:37 +0200 Subject: [multiple changes] 2016-07-06 Arnaud Charlet * 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 * 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 * sem_ch12.adb, sem_ch4.adb, sem_ch6.adb: Minor reformatting. 2016-07-06 Hristian Kirtchev * gnat1drv.adb: Code clean up. Do not emit any code generation errors when the unit is ignored Ghost. 2016-07-06 Ed Schonberg * 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 * 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 * sem_prag.adb (Analyze_Pragma.Process_Inline.Set_Inline_Flags): Special case for unanalyzed body entity of ghost expression function. From-SVN: r238050 --- gcc/ada/sem_eval.adb | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) (limited to 'gcc/ada/sem_eval.adb') diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 6ce9363..314c110 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; -- cgit v1.1