Patchwork [Ada] Validity checks in generated equality function

login
register
mail settings
Submitter Arnaud Charlet
Date June 23, 2010, 6:39 a.m.
Message ID <20100623063953.GA28856@adacore.com>
Download mbox | patch
Permalink /patch/56595/
State New
Headers show

Comments

Arnaud Charlet - June 23, 2010, 6:39 a.m.
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.

Patch

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;