From patchwork Fri Jun 18 08:18:30 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 56147 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 BB9E3B7D89 for ; Fri, 18 Jun 2010 18:18:27 +1000 (EST) Received: (qmail 3495 invoked by alias); 18 Jun 2010 08:18:23 -0000 Received: (qmail 3474 invoked by uid 22791); 18 Jun 2010 08:18:20 -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; Fri, 18 Jun 2010 08:18:15 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id D72D9CB01F8; Fri, 18 Jun 2010 10:18:21 +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 VildEyYk+X9f; Fri, 18 Jun 2010 10:18:21 +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 AE2ABCB01E2; Fri, 18 Jun 2010 10:18:21 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 317C3D9B31; Fri, 18 Jun 2010 10:18:30 +0200 (CEST) Date: Fri, 18 Jun 2010 10:18:30 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Warn on assigning to packed atomic component Message-ID: <20100618081830.GA1757@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 an assignment is made to a component of a packed atomic object, the generated code may have to do a load/modify/store sequence that results in possibly unexpected references to the atomic object. This patch generates warnings in this situation: 1. function atomicwarn return Boolean is 2. type r is record 3. a, b, c : Boolean; 4. end record; 5. pragma Pack (r); 6. pragma Atomic (r); 7. rv : r; 8. type a is array (0 .. 31) of Boolean; 9. pragma Pack (a); 10. pragma Atomic (a); 11. av : a; 12. 13. begin 14. rv.a := True; | >>> warning: assignment to component of packed atomic record >>> warning: may cause unexpected accesses to atomic object 15. av (3) := true; | >>> warning: assignment to component of packed atomic array >>> warning: may cause unexpected accesses to atomic object 16. return rv.b and av (4); 17. end; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-18 Robert Dewar * sem_res.adb (Analyze_Indexed_Component, Analyze_Selected_Component): Warn on assigning to packed atomic component. Index: sem_res.adb =================================================================== --- sem_res.adb (revision 160959) +++ sem_res.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- -- @@ -6635,6 +6635,24 @@ package body Sem_Res is Warn_On_Suspicious_Index (Name, First (Expressions (N))); Eval_Indexed_Component (N); end if; + + -- If the array type is atomic, and is packed, and we are in a left side + -- context, then this is worth a warning, since we have a situation + -- where the access to the component may cause extra read/writes of + -- the atomic array object, which could be considered unexpected. + + if Nkind (N) = N_Indexed_Component + and then (Is_Atomic (Array_Type) + or else (Is_Entity_Name (Prefix (N)) + and then Is_Atomic (Entity (Prefix (N))))) + and then Is_Bit_Packed_Array (Array_Type) + and then Is_LHS (N) + then + Error_Msg_N ("?assignment to component of packed atomic array", + Prefix (N)); + Error_Msg_N ("?\may cause unexpected accesses to atomic object", + Prefix (N)); + end if; end Resolve_Indexed_Component; ----------------------------- @@ -7715,7 +7733,6 @@ package body Sem_Res is Comp := Next_Entity (Comp); end loop; - end if; Get_Next_Interp (I, It); @@ -7784,6 +7801,23 @@ package body Sem_Res is -- Note: No Eval processing is required, because the prefix is of a -- record type, or protected type, and neither can possibly be static. + -- If the array type is atomic, and is packed, and we are in a left side + -- context, then this is worth a warning, since we have a situation + -- where the access to the component may cause extra read/writes of + -- the atomic array object, which could be considered unexpected. + + if Nkind (N) = N_Selected_Component + and then (Is_Atomic (T) + or else (Is_Entity_Name (Prefix (N)) + and then Is_Atomic (Entity (Prefix (N))))) + and then Is_Packed (T) + and then Is_LHS (N) + then + Error_Msg_N ("?assignment to component of packed atomic record", + Prefix (N)); + Error_Msg_N ("?\may cause unexpected accesses to atomic object", + Prefix (N)); + end if; end Resolve_Selected_Component; -------------------