| Message ID | 20171014164818.GA103205@adacore.com |
|---|---|
| State | New |
| Headers | show |
| Series | [Ada] Missing validity check on record type component | expand |
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))
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 <miranda@adacore.com> * checks.adb (Ensure_Valid): Do not skip adding the validity check on renamings of objects that come from the sources.