[Ada] Missing Constraint_Error in illegal conversion to C type

Submitted by Arnaud Charlet on Aug. 6, 2012, 7:40 a.m.

Details

Message ID 20120806074014.GA18766@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Aug. 6, 2012, 7:40 a.m. 
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  <kirtchev@adacore.com>

	* 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.

Patch hide | download patch | download mbox 

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 :=