[Ada] Validity checks in generated equality function
Arnaud Charlet
charlet@adacore.com
Wed Jun 23 07:46:00 GMT 2010
When validity checks and Initialize_Scalars are enabled, an equality test on
scalar uninitialized components raises a constraint error. With this patch,
a constraint error is also raised when applying the primitive equality function
to records that contain uninitialized fields.
The following must raise Constraint_Error without any other output:
gnatmake -f -q -gnatVa my_test.adb
my_test
---
with Text_IO;
procedure My_Test is
type Operation_T is (Flight_Data,
Flight_Profiles,
Flight_Addressing,
Flight_Log);
type Function_T is(Command,
Query,
Counts,
Counts_On_Flows,
Optimise);
type Origin_T is (None, Live, Simul);
type T_Abs is abstract tagged record
Operation : Operation_T;
The_Function : Function_T;
end record;
type T is new T_Abs with record
Origin : Origin_T;
end record;
X : constant T := (Operation => Flight_Data,
The_Function => Command,
Origin => None);
Y : T;
begin
Y.Operation := Flight_Data;
Y.Origin := None;
if Y /= X then
-- expect here a constraint error.
Text_Io.Put_Line ("X and Y are different");
end if;
if Y.The_Function /= X.The_Function then
-- Got here a constraint error.
Text_Io.Put_Line ("X.The_Function and Y.The_Function are different");
end if;
end My_Test;
Tested on x86_64-pc-linux-gnu, committed on trunk
2010-06-23 Ed Schonberg <schonberg@adacore.com>
* exp_ch13.adb (Expand_Freeze_Actions): If validity checks and
Initialize_Scalars are enabled, compile the generated equality function
for a composite type with full checks enabled, so that validity checks
are performed on individual components.
-------------- next part --------------
Index: exp_ch13.adb
===================================================================
--- exp_ch13.adb (revision 161073)
+++ exp_ch13.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -46,6 +46,7 @@ with Snames; use Snames;
with Stand; use Stand;
with Tbuild; use Tbuild;
with Uintp; use Uintp;
+with Validsw; use Validsw;
package body Exp_Ch13 is
@@ -346,6 +347,24 @@ package body Exp_Ch13 is
Analyze (Decl, Suppress => All_Checks);
Pop_Scope;
+ -- We treat generated equality specially, if validity checks are
+ -- enabled, in order to detect components default-initialized
+ -- with invalid values.
+
+ elsif Nkind (Decl) = N_Subprogram_Body
+ and then Chars (Defining_Entity (Decl)) = Name_Op_Eq
+ and then Validity_Checks_On
+ and then Initialize_Scalars
+ then
+ declare
+ Save_Force : constant Boolean := Force_Validity_Checks;
+
+ begin
+ Force_Validity_Checks := True;
+ Analyze (Decl);
+ Force_Validity_Checks := Save_Force;
+ end;
+
else
Analyze (Decl, Suppress => All_Checks);
end if;
More information about the Gcc-patches
mailing list