gnat_rm.texi, [...] (Analyze_Attribute, [...]): Add handling of Attribute_Ref.

2010-10-11  Arnaud Charlet  <charlet@adacore.com>

	* gnat_rm.texi, exp_attr.adb, sem_attr.adb, sem_attr.ads,
	snames.ads-tmpl (Analyze_Attribute, Expand_N_Attribute_Reference): Add
	handling of Attribute_Ref. Add missing blanks in some error messages.
	(Attribute_Ref, Name_Ref): Declare.
	Document 'Ref attribute.

From-SVN: r165291

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7e347b99acaebf01280887a90dce4e6a25bca278..be1da2d7af15bc69ac33aa4bb08c5f7bd11e3c8a 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2010-10-11  Arnaud Charlet  <charlet@adacore.com>
+
+       * gnat_rm.texi, exp_attr.adb, sem_attr.adb, sem_attr.ads,
+       snames.ads-tmpl (Analyze_Attribute, Expand_N_Attribute_Reference): Add
+       handling of Attribute_Ref. Add missing blanks in some error messages.
+       (Attribute_Ref, Name_Ref): Declare.
+       Document 'Ref attribute.
+
 2010-10-11  Robert Dewar  <dewar@adacore.com>
 
        * sem_attr.adb: Minor reformatting.

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 18864c06dfb12bd0e86df3e1d4671d511bf22614..7b29d7a3e147fc320cefac7b04445b3af8e31277 100644 (file)
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -3792,6 +3792,12 @@ package body Exp_Attr is
          Rewrite_Stream_Proc_Call (Pname);
       end Read;
 
+      ---------
+      -- Ref --
+      ---------
+
+      --  Ref is identical to To_Address, see To_Address for processing
+
       ---------------
       -- Remainder --
       ---------------
@@ -4507,10 +4513,10 @@ package body Exp_Attr is
       -- To_Address --
       ----------------
 
-      --  Transforms System'To_Address (X) into unchecked conversion
-      --  from (integral) type of X to type address.
+      --  Transforms System'To_Address (X) and System.Address'Ref (X) into
+      --  unchecked conversion from (integral) type of X to type address.
 
-      when Attribute_To_Address =>
+      when Attribute_To_Address | Attribute_Ref =>
          Rewrite (N,
            Unchecked_Convert_To (RTE (RE_Address),
              Relocate_Node (First (Exprs))));

diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 77f27c7f62ec54f65ef662dd4f99bec8ec2a2c91..0e61132323580b09b86776260bbbfd42cc81cd44 100644 (file)
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -5582,6 +5582,7 @@ consideration, you should minimize the use of these attributes.
 * Passed_By_Reference::
 * Pool_Address::
 * Range_Length::
+* Ref::
 * Result::
 * Safe_Emax::
 * Safe_Large::
@@ -6234,6 +6235,16 @@ range).  The result is static for static subtypes.  @code{Range_Length}
 applied to the index subtype of a one dimensional array always gives the
 same result as @code{Range} applied to the array itself.
 
+@node Ref
+@unnumberedsec Ref
+@findex Ref
+@noindent
+The @code{System.Address'Ref}
+(@code{System.Address} is the only permissible prefix)
+denotes a function identical to
+@code{System.Storage_Elements.To_Address} except that
+it is a static attribute.  See @ref{To_Address} for more details.
+
 @node Result
 @unnumberedsec Result
 @findex Result

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index bfddc14222d898190d5898ccd8f0a936f44062a8..75cc2db21ff0fef2ba8bfb9d8c78d529475d095f 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -2989,7 +2989,7 @@ package body Sem_Attr is
                        Ekind (Entity (P)) /= E_Enumeration_Literal)
             then
                Error_Attr_P
-                 ("prefix of %attribute must be " &
+                 ("prefix of % attribute must be " &
                   "discrete type/object or enum literal");
             end if;
          end if;
@@ -3461,7 +3461,7 @@ package body Sem_Attr is
             elsif UI_To_Int (Intval (E1)) > Number_Formals (Entity (P))
               or else UI_To_Int (Intval (E1)) < 0
             then
-               Error_Attr ("invalid parameter number for %attribute", E1);
+               Error_Attr ("invalid parameter number for % attribute", E1);
             end if;
          end if;
 
@@ -4010,6 +4010,23 @@ package body Sem_Attr is
          Resolve (N, Standard_Void_Type);
          Note_Possible_Modification (E2, Sure => True);
 
+      ---------
+      -- Ref --
+      ---------
+
+      when Attribute_Ref =>
+         Check_E1;
+         Analyze (P);
+
+         if Nkind (P) /= N_Expanded_Name
+           or else not Is_RTE (P_Type, RE_Address)
+         then
+            Error_Attr_P ("prefix of % attribute must be System.Address");
+         end if;
+
+         Analyze_And_Resolve (E1, Any_Integer);
+         Set_Etype (N, RTE (RE_Address));
+
       ---------------
       -- Remainder --
       ---------------
@@ -4405,7 +4422,7 @@ package body Sem_Attr is
          if Nkind (P) /= N_Identifier
            or else Chars (P) /= Name_System
          then
-            Error_Attr_P ("prefix of %attribute must be System");
+            Error_Attr_P ("prefix of % attribute must be System");
          end if;
 
          Generate_Reference (RTE (RE_Address), P);
@@ -7630,6 +7647,7 @@ package body Sem_Attr is
            Attribute_Position                 |
            Attribute_Priority                 |
            Attribute_Read                     |
+           Attribute_Ref                      |
            Attribute_Result                   |
            Attribute_Storage_Pool             |
            Attribute_Storage_Size             |

diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads
index 5865d8331fe5ac3925e5f36f3204752123fc6207..b1a61501f2d64cefbfa84f4f7c117a9d87743481 100644 (file)
--- a/gcc/ada/sem_attr.ads
+++ b/gcc/ada/sem_attr.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          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- --
@@ -395,6 +395,15 @@ package Sem_Attr is
       --  as Range applied to the array itself. The result is of type universal
       --  integer.
 
+      ---------
+      -- Ref --
+      ---------
+
+      Attribute_Ref => True,
+      --  System.Address'Ref (Address is the only permissible prefix) is
+      --  equivalent to System'To_Address, provided for compatibility with
+      --  other compilers.
+
       ------------------
       -- Storage_Unit --
       ------------------
@@ -439,7 +448,7 @@ package Sem_Attr is
       ----------------
 
       Attribute_To_Address => True,
-      --  System'To_Address (Address is the only permissible prefix) is a
+      --  System'To_Address (System is the only permissible prefix) is a
       --  function that takes any integer value, and converts it into an
       --  address value. The semantics is to first convert the integer value to
       --  type Integer_Address according to normal conversion rules, and then

diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 94e1ba27be8555d8e897f80c569ce0d2f648f8d4..18357cc77f439eb0976287d91bf45677927381d5 100644 (file)
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -781,6 +781,7 @@ package Snames is
    Name_Priority                       : constant Name_Id := N + $; -- Ada 05
    Name_Range                          : constant Name_Id := N + $;
    Name_Range_Length                   : constant Name_Id := N + $; -- GNAT
+   Name_Ref                            : constant Name_Id := N + $; -- GNAT
    Name_Result                         : constant Name_Id := N + $; -- GNAT
    Name_Round                          : constant Name_Id := N + $;
    Name_Safe_Emax                      : constant Name_Id := N + $; -- Ada 83
@@ -1297,6 +1298,7 @@ package Snames is
       Attribute_Priority,
       Attribute_Range,
       Attribute_Range_Length,
+      Attribute_Ref,
       Attribute_Result,
       Attribute_Round,
       Attribute_Safe_Emax,