This patch removes an optimization when evaluating integer literals within
qualified expressions that caused checks on if and case expressions to not be
generated properly.
------------
-- Source --
------------
-- call_do_smth.adb
with Test; use Test;
with Ada.Text_IO;
procedure Call_Do_Smth is
X : T;
Y : T;
begin
Do_Smth (True, X, Y);
Ada.Text_IO.Put_Line (T'Image (X));
Ada.Text_IO.Put_Line (T'Image (Y));
end Call_Do_Smth;
-- test.ads
package Test with SPARK_Mode is
subtype T is Positive range 5 .. 16;
procedure Do_Smth (I : Boolean; Oha : out T; Ohb : out T);
end Test;
-- test.adb
package body Test with SPARK_Mode is
procedure Do_Smth (I : Boolean; Oha : out T; Ohb : out T) is
V : T :=
T'(if I then
0
else
16);
V2 : T :=
T'(case I is
when True => 0,
when False => 16);
begin
Oha := V;
Ohb := V2;
end Do_Smth;
end Test;
----------------------------
-- Compilation and output --
----------------------------
$ gnatmake -q call_do_smth.adb
test.adb:6:13: value not in range of type "T" defined at test.ads:3
test.adb:6:13: "Constraint_Error" would have been raised at run time
test.adb:11:27: value not in range of type "T" defined at test.ads:3
test.adb:11:27: "Constraint_Error" would have been raised at run time
gnatmake: "test.adb" compilation error
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-01-23 Justin Squirek <squi...@adacore.com>
* sem_eval.adb (Eval_Integer_Literal): Add special
case to avoid optimizing out check if the literal appears in
an if-expression.
Index: sem_eval.adb
===================================================================
--- sem_eval.adb (revision 244773)
+++ sem_eval.adb (working copy)
@@ -2682,9 +2682,12 @@
-- 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 worth while avoiding the call.
+ -- check it, but it seems worth while to optimize out the call.
- if Nkind (Parent (N)) not in N_Subexpr
+ -- An exception is made for a literal in an if or case expression
+
+ if (Nkind_In (Parent (N), N_If_Expression, N_Case_Expression_Alternative)
+ or else Nkind (Parent (N)) not in N_Subexpr)
and then not In_Any_Integer_Context
then
Check_Non_Static_Context (N);
