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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165291 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 62 insertions, 8 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7e347b99aca..be1da2d7af1 100644
--- 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 18864c06dfb..7b29d7a3e14 100644
--- 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 77f27c7f62e..0e611323235 100644
--- 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 bfddc14222d..75cc2db21ff 100644
--- 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 5865d8331fe..b1a61501f2d 100644
--- 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 94e1ba27be8..18357cc77f4 100644
--- 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,