From patchwork Fri Sep 2 08:25:57 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 113059 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 E9E21B6F76 for ; Fri, 2 Sep 2011 18:26:22 +1000 (EST) Received: (qmail 14551 invoked by alias); 2 Sep 2011 08:26:16 -0000 Received: (qmail 14530 invoked by uid 22791); 2 Sep 2011 08:26:13 -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; Fri, 02 Sep 2011 08:25:58 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 589522BB3FB; Fri, 2 Sep 2011 04:25:57 -0400 (EDT) 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 0tU3eahjG+dX; Fri, 2 Sep 2011 04:25:57 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 393912BB3E7; Fri, 2 Sep 2011 04:25:57 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 379A03FEE8; Fri, 2 Sep 2011 04:25:57 -0400 (EDT) Date: Fri, 2 Sep 2011 04:25:57 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Implement No_Implicit_Aliasing restriction Message-ID: <20110902082557.GA5472@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 restriction, which is not required to be partition-wide consistent, requires an explicit aliased keyword for an object to which 'Access, 'Unchecked_Access, or 'Address is applied, and forbids entirely the use of the 'Unrestricted_Access attribute for objects. The following test program tests this restriction 1. pragma Restrictions (No_Implicit_Aliasing); 2. procedure NoImplicitAliasing is 3. OK : aliased Integer; 4. NOK : Integer; 5. type R is access all Integer; 6. RV : R; 7. OK1 : Integer; 8. for OK1'Address use OK'Address; 9. NOK1 : Integer; 10. for NOK1'Address use NOK'Address; | >>> violation of restriction "No_Implicit_Aliasing" at line 1 11. begin 12. RV := OK'access; 13. RV := NOK'access; | >>> violation of restriction "No_Implicit_Aliasing" at line 1 >>> prefix of "Access" attribute must be explicitly aliased 14. RV := OK'unchecked_access; 15. RV := NOK'unchecked_access; | >>> violation of restriction "No_Implicit_Aliasing" at line 1 >>> prefix of "Unchecked_Access" attribute must be explicitly aliased 16. RV := OK'unrestricted_access; | >>> violation of restriction "No_Implicit_Aliasing" at line 1 17. RV := NOK'unrestricted_access; | >>> violation of restriction "No_Implicit_Aliasing" at line 1 18. end; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-09-02 Robert Dewar * s-rident.ads: Add new restriction No_Implicit_Aliasing * sem_attr.adb: (Analyze_Access_Attribute): Deal with No_Implicit_Aliasing (Analyze_Attribute, case Address): ditto (Analyze_Attribute, case Unrestricted_Access): ditto * sem_util.ads, sem_util.adb: (Is_Aliased_View): Handle No_Implicit_Aliasing restriction. * gnat_rm.texi: Add documentation for No_Implicit_Aliasing Index: gnat_rm.texi =================================================================== --- gnat_rm.texi (revision 178381) +++ gnat_rm.texi (working copy) @@ -8988,6 +8988,17 @@ code is simplified by omitting the otherwise-required global registration of exceptions when they are declared. +@item No_Implicit_Aliasing +@findex No_Implicit_Aliasing + +This restriction, which is not required to be partition-wide consistent, +requires an explicit aliased keyword for an object to which 'Access, +'Unchecked_Access, or 'Address is applied, and forbids entirely the use of +the 'Unrestricted_Access attribute for objects. Note: the reason that +Unrestricted_Access is forbidden is that it would require the prefix +to be aliased, and in such cases, it can always be replaced by +the standard attribute Unchecked_Access which is preferable. + @item No_Implicit_Conditionals @findex No_Implicit_Conditionals This restriction ensures that the generated code does not contain any Index: sem_attr.adb =================================================================== --- sem_attr.adb (revision 178438) +++ sem_attr.adb (working copy) @@ -837,7 +837,13 @@ and then not In_Instance and then not In_Inlined_Body then - Error_Attr_P ("prefix of % attribute must be aliased"); + if Restriction_Check_Required (No_Implicit_Aliasing) then + Error_Attr_P + ("prefix of % attribute must be explicitly aliased"); + else + Error_Attr_P + ("prefix of % attribute must be aliased"); + end if; end if; end Analyze_Access_Attribute; @@ -2221,12 +2227,20 @@ then Set_Address_Taken (Ent); - -- If we have an address of an object, and the attribute - -- comes from source, then set the object as potentially - -- source modified. We do this because the resulting address - -- can potentially be used to modify the variable and we - -- might not detect this, leading to some junk warnings. + -- Deal with No_Implicit_Aliasing restriction + if Restriction_Check_Required (No_Implicit_Aliasing) then + if not Is_Aliased_View (P) then + Check_Restriction (No_Implicit_Aliasing, P); + end if; + end if; + + -- If we have an address of an object, and the attribute + -- comes from source, then set the object as potentially + -- source modified. We do this because the resulting address + -- can potentially be used to modify the variable and we + -- might not detect this, leading to some junk warnings. + Set_Never_Set_In_Source (Ent, False); elsif (Is_Concurrent_Type (Etype (Ent)) @@ -4927,6 +4941,10 @@ when Attribute_Unrestricted_Access => if Comes_From_Source (N) then Check_Restriction (No_Unchecked_Access, N); + + if Nkind (P) in N_Has_Entity and then Is_Object (Entity (P)) then + Check_Restriction (No_Implicit_Aliasing, N); + end if; end if; if Is_Entity_Name (P) then Index: sem_util.adb =================================================================== --- sem_util.adb (revision 178434) +++ sem_util.adb (working copy) @@ -6489,9 +6489,12 @@ begin if Is_Entity_Name (Obj) then - E := Entity (Obj); + if Is_Object (E) and then not Is_Aliased (E) then + Check_Restriction (No_Implicit_Aliasing, Obj); + end if; + return (Is_Object (E) and then @@ -6526,13 +6529,10 @@ return Has_Aliased_Components (Etype (Prefix (Obj))) or else (Is_Access_Type (Etype (Prefix (Obj))) - and then - Has_Aliased_Components - (Designated_Type (Etype (Prefix (Obj))))); + and then Has_Aliased_Components + (Designated_Type (Etype (Prefix (Obj))))); - elsif Nkind (Obj) = N_Unchecked_Type_Conversion - or else Nkind (Obj) = N_Type_Conversion - then + elsif Nkind_In (Obj, N_Unchecked_Type_Conversion, N_Type_Conversion) then return Is_Tagged_Type (Etype (Obj)) and then Is_Aliased_View (Expression (Obj)); Index: sem_util.ads =================================================================== --- sem_util.ads (revision 178381) +++ sem_util.ads (working copy) @@ -753,7 +753,8 @@ function Is_Aliased_View (Obj : Node_Id) return Boolean; -- Determine if Obj is an aliased view, i.e. the name of an object to which - -- 'Access or 'Unchecked_Access can apply. + -- 'Access or 'Unchecked_Access can apply. Note that the implementation + -- takes the No_Implicit_Aiasing restriction into account. function Is_Ancestor_Package (E1 : Entity_Id; Index: s-rident.ads =================================================================== --- s-rident.ads (revision 178381) +++ s-rident.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, 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- -- @@ -128,6 +128,7 @@ No_Implementation_Attributes, -- Ada 2005 AI-257 No_Implementation_Pragmas, -- Ada 2005 AI-257 No_Implementation_Restrictions, -- GNAT + No_Implicit_Aliasing, -- GNAT No_Elaboration_Code, -- GNAT No_Obsolescent_Features, -- Ada 2005 AI-368 No_Wide_Characters, -- GNAT