Patchwork [Ada] Implement No_Implicit_Aliasing restriction

login
register
mail settings
Submitter Arnaud Charlet
Date Sept. 2, 2011, 8:25 a.m.
Message ID <20110902082557.GA5472@adacore.com>
Download mbox | patch
Permalink /patch/113059/
State New
Headers show

Comments

Arnaud Charlet - Sept. 2, 2011, 8:25 a.m.
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  <dewar@adacore.com>

	* 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

Patch

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