From patchwork Wed Jun 23 06:39:53 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 56595 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 6BD7BB6F01 for ; Wed, 23 Jun 2010 16:39:57 +1000 (EST) Received: (qmail 1444 invoked by alias); 23 Jun 2010 06:39:55 -0000 Received: (qmail 1434 invoked by uid 22791); 23 Jun 2010 06:39:54 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 23 Jun 2010 06:39:50 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 99FFFCB0249; Wed, 23 Jun 2010 08:39:53 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id Cb9p8MwSUP4O; Wed, 23 Jun 2010 08:39:53 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id 79E76CB01D4; Wed, 23 Jun 2010 08:39:53 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 63194D9AB0; Wed, 23 Jun 2010 08:39:53 +0200 (CEST) Date: Wed, 23 Jun 2010 08:39:53 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Validity checks in generated equality function Message-ID: <20100623063953.GA28856@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 * 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. 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;