[multiple changes]

2012-07-09  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb: Extend previous change to elementary types.

2012-07-09  Javier Miranda  <miranda@adacore.com>

	* exp_ch8.adb (Expand_N_Subprogram_Renaming_Declaration): Reverse
	previous patch since unconditionally handling as renaming_as_body
	renamings of predefined dispatching equality and unequality operator
	cause visibility problems with private overridings of the equality
	operator (see ACATS C854001).

2012-07-09  Vincent Pucci  <pucci@adacore.com>

	* exp_attr.adb (Signal_Bad_Attribute): Raise Program_Error in
	case of internal attribute names (already rejected by the parser).
	* par-ch13.adb (P_Representation_Clause): Complain if an internal
	attribute name that comes from source occurs.
	* par-ch4.adb (P_Name): Complain if an internal attribute name
	occurs in the context of an attribute reference.
	* par-util.adb (Signal_Bad_Attribute): Don't complain about
	mispelling attribute with internal attributes.
	* sem_attr.adb (Analyze_Attribute): Raise Program_Error in case
	of internal attribute names (already rejected by the parser).
	* snames.adb-tmpl (Is_Internal_Attribute_Name): New routine.
	* snames.ads-tmpl: Attributes CPU, Dispatching_Domain and
	Interrupt_Priority are marked as INT attributes since they
	don't denote real attribute and are only used internally in
	the compiler.
	(Is_Internal_Attribute_Name): New routine.

From-SVN: r189378

10 files changed, 89 insertions, 80 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 627ccaf..57d3b04 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,34 @@
+2012-07-09  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb: Extend previous change to elementary types.
+
+2012-07-09  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch8.adb (Expand_N_Subprogram_Renaming_Declaration): Reverse
+	previous patch since unconditionally handling as renaming_as_body
+	renamings of predefined dispatching equality and unequality operator
+	cause visibility problems with private overridings of the equality
+	operator (see ACATS C854001).
+
+2012-07-09  Vincent Pucci  <pucci@adacore.com>
+
+	* exp_attr.adb (Signal_Bad_Attribute): Raise Program_Error in
+	case of internal attribute names (already rejected by the parser).
+	* par-ch13.adb (P_Representation_Clause): Complain if an internal
+	attribute name that comes from source occurs.
+	* par-ch4.adb (P_Name): Complain if an internal attribute name
+	occurs in the context of an attribute reference.
+	* par-util.adb (Signal_Bad_Attribute): Don't complain about
+	mispelling attribute with internal attributes.
+	* sem_attr.adb (Analyze_Attribute): Raise Program_Error in case
+	of internal attribute names (already rejected by the parser).
+	* snames.adb-tmpl (Is_Internal_Attribute_Name): New routine.
+	* snames.ads-tmpl: Attributes CPU, Dispatching_Domain and
+	Interrupt_Priority are marked as INT attributes since they
+	don't denote real attribute and are only used internally in
+	the compiler.
+	(Is_Internal_Attribute_Name): New routine.
+
 2012-07-09  Thomas Quinot  <quinot@adacore.com>
 
 	* einfo.adb (Set_Reverse_Storage_Order): Update assertion,
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index ad75f90..5859b6e 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -835,13 +835,16 @@ package body Exp_Attr is
            Attribute_Default_Iterator     |
            Attribute_Implicit_Dereference |
            Attribute_Iterator_Element     |
-           Attribute_Variable_Indexing    => null;
+           Attribute_Variable_Indexing    =>
+         null;
 
-      --  Attributes related to Ada 2012 aspects
+      --  Internal attributes used to deal with Ada 2012 delayed aspects
+      --  (already diagnosed by parser, thus nothing more to do here).
 
       when Attribute_CPU                |
            Attribute_Dispatching_Domain |
-           Attribute_Interrupt_Priority => null;
+           Attribute_Interrupt_Priority =>
+         raise Program_Error;
 
       ------------
       -- Access --
diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb
index 3647ceb..b0e525e 100644
--- a/gcc/ada/exp_ch8.adb
+++ b/gcc/ada/exp_ch8.adb
@@ -300,8 +300,7 @@ package body Exp_Ch8 is
       --  Handle cases where we build a body for a renamed equality
 
       if Is_Entity_Name (Nam)
-        and then (Chars (Entity (Nam)) = Name_Op_Ne
-                   or else Chars (Entity (Nam)) = Name_Op_Eq)
+        and then Chars (Entity (Nam)) = Name_Op_Eq
         and then Scope (Entity (Nam)) = Standard_Standard
       then
          declare
@@ -315,7 +314,6 @@ package body Exp_Ch8 is
             --  untagged record type (AI05-0123).
 
             if Ada_Version >= Ada_2012
-              and then Chars (Entity (Nam)) = Name_Op_Eq
               and then Is_Record_Type (Typ)
               and then not Is_Tagged_Type (Typ)
               and then not Is_Frozen (Typ)
@@ -337,71 +335,11 @@ package body Exp_Ch8 is
                          Expand_Record_Equality
                            (Id,
                             Typ => Typ,
-                            Lhs =>
-                              Make_Identifier (Loc, Chars (First_Formal (Id))),
-                            Rhs =>
-                              Make_Identifier
-                                (Loc, Chars (Next_Formal (First_Formal (Id)))),
+                            Lhs => Make_Identifier (Loc, Chars (Left)),
+                            Rhs => Make_Identifier (Loc, Chars (Right)),
                             Bodies => Declarations (Decl))))));
 
                Append (Decl, List_Containing (N));
-
-            --  Handle renamings of predefined dispatching equality operators.
-            --  When we analyze a renaming of the equality operator of a tagged
-            --  type, the predefined dispatching primitives are not available
-            --  (since they are added by the expander when the tagged type is
-            --  frozen) and hence they are left decorated as renamings of the
-            --  standard non-dispatching operators. Here we generate a body
-            --  for such renamings which invokes the predefined dispatching
-            --  equality operator.
-
-            --  Example:
-
-            --    type T is tagged null record;
-            --    function  Eq (X, Y : T1) return Boolean renames "=";
-            --    function Neq (X, Y : T1) return Boolean renames "/=";
-
-            elsif Is_Record_Type (Typ)
-              and then Is_Tagged_Type (Typ)
-              and then Is_Dispatching_Operation (Id)
-              and then not Is_Dispatching_Operation (Entity (Nam))
-            then
-               pragma Assert (not Is_Frozen (Typ));
-
-               Decl := Build_Body_For_Renaming;
-
-               --  Clean decoration of intrinsic subprogram
-
-               Set_Is_Intrinsic_Subprogram (Id, False);
-               Set_Convention (Id, Convention_Ada);
-
-               if Chars (Entity (Nam)) = Name_Op_Ne then
-                  Set_Handled_Statement_Sequence (Decl,
-                    Make_Handled_Sequence_Of_Statements (Loc,
-                      Statements => New_List (
-                        Make_Simple_Return_Statement (Loc,
-                          Expression =>
-                             Make_Op_Not (Loc,
-                               Make_Op_Eq (Loc,
-                                 Left_Opnd  =>
-                                   New_Reference_To (Left, Loc),
-                                 Right_Opnd =>
-                                   New_Reference_To (Right, Loc)))))));
-
-               else pragma Assert (Chars (Entity (Nam)) = Name_Op_Eq);
-                  Set_Handled_Statement_Sequence (Decl,
-                    Make_Handled_Sequence_Of_Statements (Loc,
-                      Statements => New_List (
-                        Make_Simple_Return_Statement (Loc,
-                          Expression =>
-                            Make_Op_Eq (Loc,
-                              Left_Opnd  =>
-                                New_Reference_To (Left, Loc),
-                              Right_Opnd =>
-                                New_Reference_To (Right, Loc))))));
-               end if;
-
-               Append (Decl, List_Containing (N));
             end if;
          end;
       end if;
diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb
index 9526e32..79d9098 100644
--- a/gcc/ada/par-ch13.adb
+++ b/gcc/ada/par-ch13.adb
@@ -221,7 +221,14 @@ package body Ch13 is
             if Token = Tok_Identifier then
                Attr_Name := Token_Name;
 
-               if not Is_Attribute_Name (Attr_Name) then
+               --  Note that the parser must complain in case of an internal
+               --  attribute names that comes from source since internal names
+               --  are meant to be used only by the compiler.
+
+               if not Is_Attribute_Name (Attr_Name)
+                 or else (Is_Internal_Attribute_Name (Attr_Name)
+                           and then Comes_From_Source (Token_Node))
+               then
                   Signal_Bad_Attribute;
                end if;
 
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 79aa85f..f16d828 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -434,7 +434,12 @@ package body Ch4 is
             elsif Token = Tok_Identifier then
                Attr_Name := Token_Name;
 
-               if not Is_Attribute_Name (Attr_Name) then
+               --  Note that internal attributes names don't denote real
+               --  attribute.
+
+               if not Is_Attribute_Name (Attr_Name)
+                 or else Is_Internal_Attribute_Name (Attr_Name)
+               then
                   if Apostrophe_Should_Be_Semicolon then
                      Expr_Form := EF_Name;
                      return Name_Node;
diff --git a/gcc/ada/par-util.adb b/gcc/ada/par-util.adb
index f281c79..eb19a0a 100644
--- a/gcc/ada/par-util.adb
+++ b/gcc/ada/par-util.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -721,7 +721,12 @@ package body Util is
 
       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
+         --  No mispelling possible with internal attribute names since they
+         --  don't denote real attribute.
+
+         if not Is_Internal_Attribute_Name (Error_Msg_Name_1)
+           and then Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1)
+         then
             Error_Msg_N -- CODEFIX
               ("\possible misspelling of %", Token_Node);
             exit;
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index efb6037f..dd5faef 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -2215,13 +2215,13 @@ package body Sem_Attr is
            Attribute_Variable_Indexing    =>
          Error_Msg_N ("illegal attribute", N);
 
-      --  Attributes related to Ada 2012 aspects. Attribute definition clause
-      --  exists for these, but they cannot be queried.
+      --  Internal attributes used to deal with Ada 2012 delayed aspects
+      --  (already diagnosed by parser, thus nothing more to do here).
 
       when Attribute_CPU                |
            Attribute_Dispatching_Domain |
            Attribute_Interrupt_Priority =>
-         Error_Msg_N ("illegal attribute", N);
+         raise Program_Error;
 
       ------------------
       -- Abort_Signal --
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index e475000..049ba05 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -7737,10 +7737,10 @@ package body Sem_Ch13 is
 
       --  Reject patently improper size values.
 
-      if Is_Scalar_Type (T)
+      if Is_Elementary_Type (T)
         and then Siz > UI_From_Int (Int'Last)
       then
-         Error_Msg_N ("Size value too large for scalar type", N);
+         Error_Msg_N ("Size value too large for elementary type", N);
          if Nkind (Original_Node (N)) = N_Op_Expon then
             Error_Msg_N
               ("\maybe '* was meant, rather than '*'*", Original_Node (N));
diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl
index 4ac3c22..da17d310 100644
--- a/gcc/ada/snames.adb-tmpl
+++ b/gcc/ada/snames.adb-tmpl
@@ -392,6 +392,17 @@ package body Snames is
                    or else N not in Ada_2012_Reserved_Words);
    end Is_Keyword_Name;
 
+   --------------------------------
+   -- Is_Internal_Attribute_Name --
+   --------------------------------
+
+   function Is_Internal_Attribute_Name (N : Name_Id) return Boolean is
+   begin
+      return N = Name_CPU
+        or N = Name_Interrupt_Priority
+        or N = Name_Dispatching_Domain;
+   end Is_Internal_Attribute_Name;
+
    ----------------------------
    -- Is_Locking_Policy_Name --
    ----------------------------
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index bffc420..1697957 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -753,6 +753,11 @@ package Snames is
    --  implementation dependent attributes may be found in the appropriate
    --  section in Sem_Attr.
 
+   --  The entries marked INT are not real attributes. They are special names
+   --  used internally by GNAT in order to deal with delayed aspects
+   --  (Aspect_CPU, Aspect_Dispatching_Domain, Aspect_Interrupt_Priority) that
+   --  don't have corresponding pragma or attribute.
+
    --  The entries marked VMS are recognized only in OpenVMS implementations
    --  of GNAT, and are treated as illegal in all other contexts.
 
@@ -779,7 +784,7 @@ package Snames is
    Name_Constant_Indexing              : constant Name_Id := N + $; -- GNAT
    Name_Constrained                    : constant Name_Id := N + $;
    Name_Count                          : constant Name_Id := N + $;
-   Name_CPU                            : constant Name_Id := N + $; -- Ada 12
+   Name_CPU                            : constant Name_Id := N + $; -- INT
    Name_Default_Bit_Order              : constant Name_Id := N + $; -- GNAT
    Name_Default_Iterator               : constant Name_Id := N + $; -- GNAT
    Name_Definite                       : constant Name_Id := N + $;
@@ -787,7 +792,7 @@ package Snames is
    Name_Denorm                         : constant Name_Id := N + $;
    Name_Descriptor_Size                : constant Name_Id := N + $;
    Name_Digits                         : constant Name_Id := N + $;
-   Name_Dispatching_Domain             : constant Name_Id := N + $; -- Ada 12
+   Name_Dispatching_Domain             : constant Name_Id := N + $; -- INT
    Name_Elaborated                     : constant Name_Id := N + $; -- GNAT
    Name_Emax                           : constant Name_Id := N + $; -- Ada 83
    Name_Enabled                        : constant Name_Id := N + $; -- GNAT
@@ -809,7 +814,7 @@ package Snames is
    Name_Img                            : constant Name_Id := N + $; -- GNAT
    Name_Implicit_Dereference           : constant Name_Id := N + $; -- GNAT
    Name_Integer_Value                  : constant Name_Id := N + $; -- GNAT
-   Name_Interrupt_Priority             : constant Name_Id := N + $; -- Ada 12
+   Name_Interrupt_Priority             : constant Name_Id := N + $; -- INT
    Name_Invalid_Value                  : constant Name_Id := N + $; -- GNAT
    Name_Iterator_Element               : constant Name_Id := N + $; -- GNAT
    Name_Large                          : constant Name_Id := N + $; -- Ada 83
@@ -1826,6 +1831,10 @@ package Snames is
    --  Test to see if the name N is the name of a recognized entity attribute,
    --  i.e. an attribute reference that returns an entity.
 
+   function Is_Internal_Attribute_Name (N : Name_Id) return Boolean;
+   --  Test to see if the name N is the name of an INT attribute (Name_CPU,
+   --  Name_Dispatching_Domain, Name_Interrupt_Priority).
+
    function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean;
    --  Test to see if the name N is the name of a recognized attribute that
    --  designates a procedure (and can therefore appear as a statement).