This patch corrects an issue whereby spurious unhandled exception warnings on
integer literals within static if and case expressions would be emitted when
the restriction No_Exception_Propagation is enabled.
------------
-- Source --
------------
-- gnat.adc
pragma Restrictions (No_Exception_Propagation);
pragma SPARK_Mode (On);
-- pack.ads
package Pack is
procedure Filter (Ret : out Integer);
end Pack;
-- pack.adb
package body Pack is
subtype Nat is Integer range 0 .. 10;
Default : constant Nat := 1;
User_Override : constant Integer := -1;
procedure Filter (Ret : out Integer) is
Val : constant Nat :=
(if User_Override in Nat then
User_Override
else
Default);
begin
Ret := Val;
end Filter;
end Pack;
----------------------------
-- Compilation and output --
----------------------------
& gcc -c -gnatp -gnatwa pack.adb
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-07-16 Justin Squirek <squi...@adacore.com>
gcc/ada/
* sem_eval.adb (Eval_Integer_Literal): Add exception for avoiding
checks on expanded literals within if and case expressions.
--- gcc/ada/sem_eval.adb
+++ gcc/ada/sem_eval.adb
@@ -2720,16 +2720,23 @@ package body Sem_Eval is
-- Start of processing for Eval_Integer_Literal
begin
-
-- If the literal appears in a non-expression context, then it is
-- certainly appearing in a non-static context, so check it. This is
-- actually a redundant check, since Check_Non_Static_Context would
-- check it, but it seems worthwhile to optimize out the call.
- -- An exception is made for a literal in an if or case expression
+ -- Additionally, when the literal appears within an if or case
+ -- expression it must be checked as well. However, due to the literal
+ -- appearing within a conditional statement, expansion greatly changes
+ -- the nature of its context and performing some of the checks within
+ -- Check_Non_Static_Context on an expanded literal may lead to spurious
+ -- and misleading warnings.
if (Nkind_In (Parent (N), N_If_Expression, N_Case_Expression_Alternative)
or else Nkind (Parent (N)) not in N_Subexpr)
+ and then (not Nkind_In (Parent (N), N_If_Expression,
+ N_Case_Expression_Alternative)
+ or else Comes_From_Source (N))
and then not In_Any_Integer_Context
then
Check_Non_Static_Context (N);