[Ada] New implementation-defined pragma: Attribute_Definition

Index: gnat_rm.texi
===================================================================
--- gnat_rm.texi	(revision 192933)
+++ gnat_rm.texi	(working copy)
@@ -107,6 +107,7 @@ 
 * Pragma Assert::
 * Pragma Assertion_Policy::
 * Pragma Assume_No_Invalid_Values::
+* Pragma Attribute_Definition::
 * Pragma Ast_Entry::
 * Pragma C_Pass_By_Copy::
 * Pragma Check::
@@ -845,6 +846,7 @@ 
 * Pragma Assert::
 * Pragma Assertion_Policy::
 * Pragma Assume_No_Invalid_Values::
+* Pragma Attribute_Definition::
 * Pragma Ast_Entry::
 * Pragma C_Pass_By_Copy::
 * Pragma Check::
@@ -1308,6 +1310,28 @@ 
 normal use of the entry.  For further details on this pragma, see the
 DEC Ada Language Reference Manual, section 9.12a.
 
+@node Pragma Attribute_Definition
+@unnumberedsec Pragma Attribute_Definition
+@findex Attribute_Definition
+@noindent
+Syntax:
+@smallexample @c ada
+pragma Attribute_Definition
+  ([Attribute  =>] ATTRIBUTE_DESIGNATOR,
+   [Entity     =>] LOCAL_NAME,
+   [Expression =>] EXPRESSION | NAME);
+@end smallexample
+
+@noindent
+If Attribute is a known attribute name, this pragma is equivalent to
+the attribute definition clause:
+@smallexample @c ada
+  for Entity'Attribute use Expression;
+@end smallexample
+else the pragma is ignored, and a warning is emitted. This allows source
+code to be written that takes advantage of some new attribute, while remaining
+compilable with earlier compilers.
+
 @node Pragma C_Pass_By_Copy
 @unnumberedsec Pragma C_Pass_By_Copy
 @cindex Passing by copy
Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 192934)
+++ sem_prag.adb	(working copy)
@@ -6919,6 +6919,47 @@ 
                Assume_No_Invalid_Values := False;
             end if;
 
+         --------------------------
+         -- Attribute_Definition --
+         --------------------------
+
+         --  pragma Attribute_Definition
+         --    ([Attribute  =>] ATTRIBUTE_DESIGNATOR,
+         --     [Entity     =>] LOCAL_NAME,
+         --     [Expression =>] EXPRESSION | NAME);
+
+         when Pragma_Attribute_Definition => Attribute_Definition : declare
+            Attribute_Designator : constant Node_Id := Get_Pragma_Arg (Arg1);
+            Aname : Name_Id;
+
+         begin
+            GNAT_Pragma;
+            Check_Arg_Count (3);
+            Check_Optional_Identifier (Arg1, "attribute");
+            Check_Optional_Identifier (Arg2, "entity");
+            Check_Optional_Identifier (Arg3, "expression");
+
+            if Nkind (Attribute_Designator) /= N_Identifier then
+               Error_Msg_N ("attribute name expected", Attribute_Designator);
+               return;
+            end if;
+
+            Check_Arg_Is_Local_Name (Arg2);
+
+            Aname := Chars (Attribute_Designator);
+            if not Is_Attribute_Name (Aname) then
+               Bad_Attribute (Attribute_Designator, Aname, Warn => True);
+               return;
+            end if;
+
+            Rewrite (N,
+              Make_Attribute_Definition_Clause (Loc,
+                Name       => Get_Pragma_Arg (Arg2),
+                Chars      => Aname,
+                Expression => Get_Pragma_Arg (Arg3)));
+            Analyze (N);
+         end Attribute_Definition;
+
          ---------------
          -- AST_Entry --
          ---------------
@@ -15289,6 +15330,7 @@ 
       Pragma_Assert_And_Cut                 => -1,
       Pragma_Assertion_Policy               =>  0,
       Pragma_Assume_No_Invalid_Values       =>  0,
+      Pragma_Attribute_Definition           => +3,
       Pragma_Asynchronous                   => -1,
       Pragma_Atomic                         =>  0,
       Pragma_Atomic_Components              =>  0,
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 192918)
+++ sem_util.adb	(working copy)
@@ -36,6 +36,7 @@ 
 with Freeze;   use Freeze;
 with Lib;      use Lib;
 with Lib.Xref; use Lib.Xref;
+with Namet.Sp; use Namet.Sp;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
 with Output;   use Output;
@@ -404,6 +405,33 @@ 
         and then Scope_Depth (ST) >= Scope_Depth (SCT);
    end Available_Full_View_Of_Component;
 
+   -------------------
+   -- Bad_Attribute --
+   -------------------
+
+   procedure Bad_Attribute
+     (N    : Node_Id;
+      Nam  : Name_Id;
+      Warn : Boolean := False)
+   is
+   begin
+      Error_Msg_Warn := Warn;
+      Error_Msg_N ("unrecognized attribute&<", N);
+
+      --  Check for possible misspelling
+
+      Error_Msg_Name_1 := First_Attribute_Name;
+      while Error_Msg_Name_1 <= Last_Attribute_Name loop
+         if Is_Bad_Spelling_Of (Nam, Error_Msg_Name_1) then
+            Error_Msg_N -- CODEFIX
+              ("\possible misspelling of %<", N);
+            exit;
+         end if;
+
+         Error_Msg_Name_1 := Error_Msg_Name_1 + 1;
+      end loop;
+   end Bad_Attribute;
+
    --------------------------------
    -- Bad_Predicated_Subtype_Use --
    --------------------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads	(revision 192918)
+++ sem_util.ads	(working copy)
@@ -108,6 +108,14 @@ 
    --  are open, and the scope of the array is not outside the scope of the
    --  component.
 
+   procedure Bad_Attribute
+     (N    : Node_Id;
+      Nam  : Name_Id;
+      Warn : Boolean := False);
+   --  Called when node N is expected to contain a valid attribute name, and
+   --  Nam is found instead. If Warn is set True this is a warning, else this
+   --  is an error.
+
    procedure Bad_Predicated_Subtype_Use
      (Msg : String;
       N   : Node_Id;
Index: par-prag.adb
===================================================================
--- par-prag.adb	(revision 192928)
+++ par-prag.adb	(working copy)
@@ -1103,6 +1103,7 @@ 
            Pragma_Atomic                         |
            Pragma_Atomic_Components              |
            Pragma_Attach_Handler                 |
+           Pragma_Attribute_Definition           |
            Pragma_Check                          |
            Pragma_Check_Name                     |
            Pragma_Check_Policy                   |
Index: par-util.adb
===================================================================
--- par-util.adb	(revision 192927)
+++ par-util.adb	(working copy)
@@ -716,20 +716,7 @@ 
 
    procedure Signal_Bad_Attribute is
    begin
-      Error_Msg_N ("unrecognized attribute&", Token_Node);
-
-      --  Check for possible misspelling
-
-      Error_Msg_Name_1 := First_Attribute_Name;
-      while Error_Msg_Name_1 <= Last_Attribute_Name loop
-         if Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1) then
-            Error_Msg_N -- CODEFIX
-              ("\possible misspelling of %", Token_Node);
-            exit;
-         end if;
-
-         Error_Msg_Name_1 := Error_Msg_Name_1 + 1;
-      end loop;
+      Bad_Attribute (Token_Node, Token_Name, Warn => False);
    end Signal_Bad_Attribute;
 
    -----------------------------
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl	(revision 192929)
+++ snames.ads-tmpl	(working copy)
@@ -363,6 +363,7 @@ 
    Name_Annotate                       : constant Name_Id := N + $; -- GNAT
    Name_Assertion_Policy               : constant Name_Id := N + $; -- Ada 05
    Name_Assume_No_Invalid_Values       : constant Name_Id := N + $; -- GNAT
+   Name_Attribute_Definition           : constant Name_Id := N + $; -- GNAT
    Name_C_Pass_By_Copy                 : constant Name_Id := N + $; -- GNAT
    Name_Check_Name                     : constant Name_Id := N + $; -- GNAT
    Name_Check_Policy                   : constant Name_Id := N + $; -- GNAT
@@ -1646,6 +1647,7 @@ 
       Pragma_Annotate,
       Pragma_Assertion_Policy,
       Pragma_Assume_No_Invalid_Values,
+      Pragma_Attribute_Definition,
       Pragma_C_Pass_By_Copy,
       Pragma_Check_Name,
       Pragma_Check_Policy,