This patch removes an old range check optimization which incorrectly assumes
that the type of an arbitrary expression can always fit in the target type of a
conversion.
------------
-- Source --
------------
-- main.adb
with Interfaces; use Interfaces;
procedure Main is
subtype Small_Positive is Integer_16 range 1 .. Integer_16'Last;
type Target_Typ is array (Small_Positive range <>) of Boolean;
pragma Convention (C, Target_Typ);
subtype Large_Positive is Integer_32 range 1 .. 60_000;
type Expr_Typ is array (Large_Positive range <>) of Boolean;
type Expr_Typ_Ptr is access Expr_Typ;
Expr : constant Expr_Typ := (1 .. 60_000 => True);
Expr_Ptr : constant Expr_Typ_Ptr := new Expr_Typ'(Expr);
Target : constant Target_Typ := Target_Typ (Expr_Ptr.all);
begin
null;
end Main;
----------------------------
-- Compilation and output --
----------------------------
$ gnatmake -q main.adb
$ ./main.adb
raised CONSTRAINT_ERROR : main.adb:16 range check failed
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-08-06 Hristian Kirtchev <[email protected]>
* checks.adb (Discrete_Range_Cond): Do not try to optimize on
the assumption that the type of an expression can always fit in
the target type of a conversion.
Index: checks.adb
===================================================================
--- checks.adb (revision 190155)
+++ checks.adb (working copy)
@@ -6660,12 +6660,6 @@
LB := New_Occurrence_Of (Discriminal (Entity (LB)), Loc);
end if;
- if Nkind (HB) = N_Identifier
- and then Ekind (Entity (HB)) = E_Discriminant
- then
- HB := New_Occurrence_Of (Discriminal (Entity (HB)), Loc);
- end if;
-
Left_Opnd :=
Make_Op_Lt (Loc,
Left_Opnd =>
@@ -6677,28 +6671,10 @@
(Base_Type (Typ),
Get_E_First_Or_Last (Loc, Typ, 0, Name_First)));
- if Base_Type (Typ) = Typ then
- return Left_Opnd;
-
- elsif Compile_Time_Known_Value (High_Bound (Scalar_Range (Typ)))
- and then
- Compile_Time_Known_Value (High_Bound (Scalar_Range
- (Base_Type (Typ))))
+ if Nkind (HB) = N_Identifier
+ and then Ekind (Entity (HB)) = E_Discriminant
then
- if Is_Floating_Point_Type (Typ) then
- if Expr_Value_R (High_Bound (Scalar_Range (Typ))) =
- Expr_Value_R (High_Bound (Scalar_Range (Base_Type (Typ))))
- then
- return Left_Opnd;
- end if;
-
- else
- if Expr_Value (High_Bound (Scalar_Range (Typ))) =
- Expr_Value (High_Bound (Scalar_Range (Base_Type (Typ))))
- then
- return Left_Opnd;
- end if;
- end if;
+ HB := New_Occurrence_Of (Discriminal (Entity (HB)), Loc);
end if;
Right_Opnd :=
