The compiler may silently skip generating a validity check on a
type conversion of a component of a record type. After this patch
the error is reported on the following sources.
pragma Initialize_Scalars;
package Pkg is
type T is record
Major : Natural;
Minor : Natural;
end record;
procedure Do_Test (Value : in out T);
end;
pragma Initialize_Scalars;
package body Pkg is
type Integer_T is range -2 ** 31 .. 2 ** 31 - 1;
subtype Natural_T is Integer_T range 0 .. Integer_T'Last;
Next_Val : Integer_T := 0;
procedure Do_Update (Int : in out Integer_T) is
begin
Next_Val := Next_Val + 1;
if Next_Val > 1000 then
Next_Val := Int;
else
Int := Next_Val;
end if;
end;
procedure Do_Test (Value : in out T) is
begin
Do_Update (Natural_T (Value.Minor)); -- Run-time error
end;
end;
with Pkg; use Pkg;
procedure Main is
Obj : T;
begin
Do_Test (Obj);
end Main;
Command: gnatmake -q -gnatVaM main.adb; ./main
Output:
raised CONSTRAINT_ERROR : pkg.adb:20 invalid data
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-10-14 Javier Miranda <[email protected]>
* checks.adb (Ensure_Valid): Do not skip adding the validity check on
renamings of objects that come from the sources.
Index: checks.adb
===================================================================
--- checks.adb (revision 253753)
+++ checks.adb (working copy)
@@ -5940,6 +5940,10 @@
-- In addition, we force a check if Force_Validity_Checks is set
elsif not Comes_From_Source (Expr)
+ and then not
+ (Nkind (Expr) = N_Identifier
+ and then Present (Renamed_Object (Entity (Expr)))
+ and then Comes_From_Source (Renamed_Object (Entity (Expr))))
and then not Force_Validity_Checks
and then (Nkind (Expr) /= N_Unchecked_Type_Conversion
or else Kill_Range_Check (Expr))
