From patchwork Mon Nov 21 11:59:38 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 126766 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 B1C3AB7205 for ; Mon, 21 Nov 2011 23:00:06 +1100 (EST) Received: (qmail 19042 invoked by alias); 21 Nov 2011 12:00:02 -0000 Received: (qmail 18904 invoked by uid 22791); 21 Nov 2011 12:00:00 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL,BAYES_00 X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 21 Nov 2011 11:59:39 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 6E3852BAFAD; Mon, 21 Nov 2011 06:59:38 -0500 (EST) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id oEdO19sTESk2; Mon, 21 Nov 2011 06:59:38 -0500 (EST) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 57A0D2BAFAC; Mon, 21 Nov 2011 06:59:38 -0500 (EST) Received: by kwai.gnat.com (Postfix, from userid 4192) id 576943FEE8; Mon, 21 Nov 2011 06:59:38 -0500 (EST) Date: Mon, 21 Nov 2011 06:59:38 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Properly detect passing volatile A.B to non-volatile formal Message-ID: <20111121115938.GA30985@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) 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 This patch provides proper detection of the error of passing pointer to volatile to pointer to non-volatile in the case of a component reference A.B. The following test program (compiled with -gnatld7 -gnatj60 -gnat2005) shows detection of this error 1. procedure Atomic_Test is 2. 3. type X32 is mod 2 ** 32; 4. 5. type X32_Array is array (1 .. 1) of aliased X32; 6. pragma Atomic_Components (X32_Array); 7. 8. type Rec is record 9. A : X32_Array; 10. B : aliased X32; 11. pragma Atomic (B); 12. end record; 13. 14. procedure Test (X : access X32) is null; 15. 16. C : aliased X32; 17. pragma Atomic (C); 18. 19. Object : Rec; 20. begin 21. Test (Object.A (1)'Access); | >>> access to volatile object cannot yield access-to-non-volatile type 22. Test (Object.B'Access); | >>> access to volatile object cannot yield access-to-non-volatile type 23. Test (C'Access); | >>> access to volatile object cannot yield access-to-non-volatile type 24. end Atomic_Test; Before the patch not all these errors were caught. This change necessitated fixes to two runtime files, namely s-atocou-builtin.adb and s-taprop-linux.adb, which had this error. These were both fixed by using Unrestricted_Access instead of Access. Tested on x86_64-pc-linux-gnu, committed on trunk 2011-11-21 Robert Dewar * s-atocou-builtin.adb (Decrement): Use Unrestricted_Access to deal with fact that we properly detect the error if Access is used. (Increment): Same fix. * s-taprop-linux.adb (Create_Task): Use Unrestricted_Access to deal with fact that we properly detect the error if Access is used. * sem_util.adb (Is_Volatile_Object): Properly record that A.B is volatile if the B component is volatile. This affects the check for passing such a by reference volatile actual to a non-volatile formal (which should be illegal) Index: sem_util.adb =================================================================== --- sem_util.adb (revision 181563) +++ sem_util.adb (working copy) @@ -8727,11 +8727,16 @@ then return True; - elsif Nkind (N) = N_Indexed_Component - or else Nkind (N) = N_Selected_Component + elsif Nkind_In (N, N_Indexed_Component, N_Selected_Component) + and then Is_Volatile_Prefix (Prefix (N)) then - return Is_Volatile_Prefix (Prefix (N)); + return True; + elsif Nkind (N) = N_Selected_Component + and then Is_Volatile (Entity (Selector_Name (N))) + then + return True; + else return False; end if; @@ -10833,9 +10838,7 @@ -- source. This excludes, for example, calls to a dispatching -- assignment operation when the left-hand side is tagged. - if Modification_Comes_From_Source - or else Alfa_Mode - then + if Modification_Comes_From_Source or else Alfa_Mode then Generate_Reference (Ent, Exp, 'm'); -- If the target of the assignment is the bound variable Index: s-taprop-linux.adb =================================================================== --- s-taprop-linux.adb (revision 181565) +++ s-taprop-linux.adb (working copy) @@ -990,12 +990,19 @@ -- do not need to manipulate caller's signal mask at this point. -- All tasks in RTS will have All_Tasks_Mask initially. - Result := pthread_create - (T.Common.LL.Thread'Access, - Attributes'Access, - Thread_Body_Access (Wrapper), - To_Address (T)); + -- Note: the use of Unrestricted_Access in the following call is needed + -- because otherwise we have an error of getting a access-to-volatile + -- value which points to a non-volatile object. But in this case it is + -- safe to do this, since we know we have no problems with aliasing and + -- Unrestricted_Access bypasses this check. + Result := + pthread_create + (T.Common.LL.Thread'Unrestricted_Access, + Attributes'Access, + Thread_Body_Access (Wrapper), + To_Address (T)); + pragma Assert (Result = 0 or else Result = EAGAIN or else Result = ENOMEM); Index: s-atocou-builtin.adb =================================================================== --- s-atocou-builtin.adb (revision 181556) +++ s-atocou-builtin.adb (working copy) @@ -50,7 +50,12 @@ function Decrement (Item : in out Atomic_Counter) return Boolean is begin - return Sync_Sub_And_Fetch (Item.Value'Access, 1) = 0; + -- Note: the use of Unrestricted_Access here is required because we + -- are obtaining an access-to-volatile pointer to a non-volatile object. + -- This is not allowed for [Unchecked_]Access, but is safe in this case + -- because we know that no aliases are being created. + + return Sync_Sub_And_Fetch (Item.Value'Unrestricted_Access, 1) = 0; end Decrement; --------------- @@ -59,7 +64,12 @@ procedure Increment (Item : in out Atomic_Counter) is begin - Sync_Add_And_Fetch (Item.Value'Access, 1); + -- Note: the use of Unrestricted_Access here is required because we + -- are obtaining an access-to-volatile pointer to a non-volatile object. + -- This is not allowed for [Unchecked_]Access, but is safe in this case + -- because we know that no aliases are being created. + + Sync_Add_And_Fetch (Item.Value'Unrestricted_Access, 1); end Increment; ------------