exp_ch2.adb: Remove "with" and "use" clauses for Namet and Snames.

2007-04-20  Hristian Kirtchev  <kirtchev@adacore.com>
	    Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>

	* exp_ch2.adb: Remove "with" and "use" clauses for Namet and Snames.
	Add "with" and "use" clauses for Sem_Attr.
	(Expand_Current_Value): Do not replace occurences of attribute
	references where the prefix must be a simple name.

	* sem_attr.ads, sem_attr.adb: Remove "with" and "use" clauses for
	Namet. Add new arrays Attribute_Name_Modifies_Prefix and
	Attribute_Requires_Simple_Name_Prefix.
	(Name_Modifies_Prefix): Body of new function.
	(Requires_Simple_Name_Prefix): Body of new function.
	(Resolve_Attribute, case Access): Improve error message for case of
	mismatched conventions.
	(Analyze_Attribute, case 'Tag): The prefix the attribute cannot be of an
	incomplete type.
	(Analyze_Attribute, case 'Access): If the type of the prefix is a
	constrained subtype for a nominal unconstrained type, use its base type
	to check for conformance with the context.
	(Resolve_Attribute): Remove test of the access type being associated
	with a return statement from condition for performing accessibility
	checks on access attributes, since this case is now captured by
	Is_Local_Anonymous_Access.
	(Analyze_Access_Attribute): Set Address_Taken on entity
	(Analyze_Attribute, case Address): Set Address_Taken on entity
	(OK_Self_Reference): Traverse tree to locate enclosing aggregate when
	validating an access attribute whose prefix is a current instance.
	(Resolve_Attribute): In case of attributes 'Code_Address and 'Address
	applied to dispatching operations, if freezing is required then we set
	the attribute Has_Delayed_Freeze in the prefix's entity.
	(Check_Local_Access): Set flag Suppress_Value_Tracking_On_Call in
	current scope if access of local subprogram taken
	(Analyze_Access_Attribute): Check legality of self-reference even if the
	expression comes from source, as when a single component association in
	an aggregate has a box association.
	(Resolve_Attribute, case 'Access): Do not apply accessibility checks to
	the prefix if it is a protected operation and the attribute is
	Unrestricted_Access.
	(Resolve_Attribute, case 'Access): Set the Etype of the attribute
	reference to the base type of the context, to force a constraint check
	when the context is an access subtype with an explicit constraint.
	(Analyze_Attribute, case 'Class): If the prefix is an interface and the
	node is rewritten as an interface conversion. leave unanalyzed after
	resolution, to ensure that type checking against the context will take
	place.

From-SVN: r125395

gcc/ada/exp_ch2.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, 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- --
@@ -35,12 +35,12 @@ with Exp_VFpt; use Exp_VFpt;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
 with Sem;      use Sem;
+with Sem_Attr; use Sem_Attr;
 with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
 with Sem_Util; use Sem_Util;
 with Sem_Warn; use Sem_Warn;
 with Sinfo;    use Sinfo;
-with Snames;   use Snames;
 with Tbuild;   use Tbuild;
 with Uintp;    use Uintp;
 
@@ -156,13 +156,12 @@ package body Exp_Ch2 is
 
          and then Nkind (Parent (N)) /= N_Pragma_Argument_Association
 
-         --  Same for Asm_Input and Asm_Output attribute references
+         --  Same for attribute references that require a simple name prefix
 
          and then not (Nkind (Parent (N)) = N_Attribute_Reference
-                         and then
-                           (Attribute_Name (Parent (N)) = Name_Asm_Input
-                              or else
-                            Attribute_Name (Parent (N)) = Name_Asm_Output))
+                         and then Requires_Simple_Name_Prefix (
+                                    Attribute_Name (Parent (N))))
+
       then
          --  Case of Current_Value is a compile time known value
 

gcc/ada/sem_attr.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, 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- --
@@ -37,7 +37,6 @@ with Expander; use Expander;
 with Freeze;   use Freeze;
 with Lib;      use Lib;
 with Lib.Xref; use Lib.Xref;
-with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
@@ -79,6 +78,7 @@ package body Sem_Attr is
    --  trouble with cascaded errors.
 
    --  The following array is the list of attributes defined in the Ada 83 RM
+   --  that are not included in Ada 95, but still get recognized in GNAT.
 
    Attribute_83 : constant Attribute_Class_Array := Attribute_Class_Array'(
       Attribute_Address           |
@@ -125,6 +125,40 @@ package body Sem_Attr is
       Attribute_Width             => True,
       others                      => False);
 
+   --  The following array is the list of attributes defined in the Ada 2005
+   --  RM which are not defined in Ada 95. These are recognized in Ada 95 mode,
+   --  but in Ada 95 they are considered to be implementation defined.
+
+   Attribute_05 : constant Attribute_Class_Array := Attribute_Class_Array'(
+      Attribute_Machine_Rounding  |
+      Attribute_Priority          |
+      Attribute_Stream_Size       |
+      Attribute_Wide_Wide_Width   => True,
+      others                      => False);
+
+   --  The following array contains all attributes that cause a modification
+   --  of their prefixes. In a certain sense, the prefix may be considered as
+   --  an lvalue.
+
+   Attribute_Name_Modifies_Prefix : constant Attribute_Class_Array :=
+      Attribute_Class_Array'(
+      Attribute_Access           |
+      Attribute_Address          |
+      Attribute_Input            |
+      Attribute_Read             |
+      Attribute_Unchecked_Access => True,
+      others                     => False);
+
+   --  The following list contains all attributes that require simple names
+   --  rather than values as their prefixes.
+
+   Attribute_Requires_Simple_Name_Prefix : constant Attribute_Class_Array :=
+      Attribute_Class_Array'(
+      Attribute_Asm_Input  |
+      Attribute_Asm_Output |
+      Attribute_Size       => True,
+      others               => False);
+
    -----------------------
    -- Local_Subprograms --
    -----------------------
@@ -311,6 +345,10 @@ package body Sem_Attr is
       --  no arguments is used when the caller has already generated the
       --  required error messages.
 
+      procedure Error_Attr_P (Msg : String);
+      pragma No_Return (Error_Attr);
+      --  Like Error_Attr, but error is posted at the start of the prefix
+
       procedure Standard_Attribute (Val : Int);
       --  Used to process attributes whose prefix is package Standard which
       --  yield values of type Universal_Integer. The attribute reference
@@ -348,7 +386,9 @@ package body Sem_Attr is
          function OK_Self_Reference return Boolean;
          --  An access reference whose prefix is a type can legally appear
          --  within an aggregate, where it is obtained by expansion of
-         --  a defaulted aggregate;
+         --  a defaulted aggregate. The enclosing aggregate that contains
+         --  the self-referenced is flagged so that the self-reference can
+         --  be expanded into a reference to the target object (see exp_aggr).
 
          ------------------------------
          -- Build_Access_Object_Type --
@@ -375,9 +415,27 @@ package body Sem_Attr is
             Index : Interp_Index;
             It    : Interp;
 
+            procedure Check_Local_Access (E : Entity_Id);
+            --  Deal with possible access to local subprogram. If we have such
+            --  an access, we set a flag to kill all tracked values on any call
+            --  because this access value may be passed around, and any called
+            --  code might use it to access a local procedure which clobbers a
+            --  tracked value.
+
             function Get_Kind (E : Entity_Id) return Entity_Kind;
             --  Distinguish between access to regular/protected subprograms
 
+            ------------------------
+            -- Check_Local_Access --
+            ------------------------
+
+            procedure Check_Local_Access (E : Entity_Id) is
+            begin
+               if not Is_Library_Level_Entity (E) then
+                  Set_Suppress_Value_Tracking_On_Call (Current_Scope);
+               end if;
+            end Check_Local_Access;
+
             --------------
             -- Get_Kind --
             --------------
@@ -401,6 +459,8 @@ package body Sem_Attr is
             Set_Etype (N, Any_Type);
 
             if not Is_Overloaded (P) then
+               Check_Local_Access (Entity (P));
+
                if not Is_Intrinsic_Subprogram (Entity (P)) then
                   Acc_Type :=
                     New_Internal_Entity
@@ -413,6 +473,8 @@ package body Sem_Attr is
             else
                Get_First_Interp (P, Index, It);
                while Present (It.Nam) loop
+                  Check_Local_Access (It.Nam);
+
                   if not Is_Intrinsic_Subprogram (It.Nam) then
                      Acc_Type :=
                        New_Internal_Entity
@@ -426,8 +488,12 @@ package body Sem_Attr is
                end loop;
             end if;
 
+            --  Cannot be applied to intrinsic. Looking at the tests above,
+            --  the only way Etype (N) can still be set to Any_Type is if
+            --  Is_Intrinsic_Subprogram was True for some referenced entity.
+
             if Etype (N) = Any_Type then
-               Error_Attr ("prefix of % attribute cannot be intrinsic", P);
+               Error_Attr_P ("prefix of % attribute cannot be intrinsic");
             end if;
          end Build_Access_Subprogram_Type;
 
@@ -441,24 +507,25 @@ package body Sem_Attr is
          begin
             Par := Parent (N);
             while Present (Par)
-              and then Nkind (Par) in N_Subexpr
+              and then
+               (Nkind (Par) = N_Component_Association
+                 or else Nkind (Par) in N_Subexpr)
             loop
-               exit when Nkind (Par) = N_Aggregate
-                 or else Nkind (Par) = N_Extension_Aggregate;
+               if Nkind (Par) = N_Aggregate
+                 or else Nkind (Par) = N_Extension_Aggregate
+               then
+                  if Etype (Par) = Typ then
+                     Set_Has_Self_Reference (Par);
+                     return True;
+                  end if;
+               end if;
+
                Par := Parent (Par);
             end loop;
 
-            if Present (Par)
-              and then
-                (Nkind (Par) = N_Aggregate
-                   or else Nkind (Par) = N_Extension_Aggregate)
-              and then Etype (Par) = Typ
-            then
-               Set_Has_Self_Reference (Par);
-               return True;
-            else
-               return False;
-            end if;
+            --  No enclosing aggregate, or not a self-reference
+
+            return False;
          end OK_Self_Reference;
 
       --  Start of processing for Analyze_Access_Attribute
@@ -467,8 +534,8 @@ package body Sem_Attr is
          Check_E0;
 
          if Nkind (P) = N_Character_Literal then
-            Error_Attr
-              ("prefix of % attribute cannot be enumeration literal", P);
+            Error_Attr_P
+              ("prefix of % attribute cannot be enumeration literal");
          end if;
 
          --  Case of access to subprogram
@@ -484,9 +551,8 @@ package body Sem_Attr is
             end if;
 
             if Is_Always_Inlined (Entity (P)) then
-               Error_Attr
-                 ("prefix of % attribute cannot be Inline_Always subprogram",
-                  P);
+               Error_Attr_P
+                 ("prefix of % attribute cannot be Inline_Always subprogram");
             end if;
 
             if Aname = Name_Unchecked_Access then
@@ -513,7 +579,7 @@ package body Sem_Attr is
            and then Is_Overloadable (Entity (Selector_Name (P)))
          then
             if Ekind (Entity (Selector_Name (P))) = E_Entry then
-               Error_Attr ("prefix of % attribute must be subprogram", P);
+               Error_Attr_P ("prefix of % attribute must be subprogram");
             end if;
 
             Build_Access_Subprogram_Type (Selector_Name (P));
@@ -565,7 +631,7 @@ package body Sem_Attr is
                   end;
 
                   if Nkind (P) = N_Expanded_Name then
-                     Error_Msg_N
+                     Error_Msg_F
                        ("current instance prefix must be a direct name", P);
                   end if;
 
@@ -608,8 +674,11 @@ package body Sem_Attr is
                --  OK if self-reference in an aggregate in Ada 2005, and
                --  the reference comes from a copied default expression.
 
+               --  Note that we check legality of self-reference even if the
+               --  expression comes from source, e.g. when a single component
+               --  association in an aggregate has a box association.
+
                elsif Ada_Version >= Ada_05
-                 and then not Comes_From_Source (N)
                  and then OK_Self_Reference
                then
                   null;
@@ -647,31 +716,38 @@ package body Sem_Attr is
             end;
          end if;
 
-         --  If we have an access to an object, and the attribute comes
-         --  from source, then set the object as potentially source modified.
-         --  We do this because the resulting access pointer can be used to
-         --  modify the variable, and we might not detect this, leading to
-         --  some junk warnings.
+         --  Special cases when prefix is entity name
 
          if Is_Entity_Name (P) then
+
+            --  If we have an access to an object, and the attribute comes from
+            --  source, then set the object as potentially source modified. We
+            --  do this because the resulting access pointer can be used to
+            --  modify the variable, and we might not detect this, leading to
+            --  some junk warnings.
+
             Set_Never_Set_In_Source (Entity (P), False);
+
+            --  Mark entity as address taken, and kill current values
+
+            Set_Address_Taken (Entity (P));
+            Kill_Current_Values (Entity (P));
          end if;
 
-         --  Check for aliased view unless unrestricted case. We allow
-         --  a nonaliased prefix when within an instance because the
-         --  prefix may have been a tagged formal object, which is
-         --  defined to be aliased even when the actual might not be
-         --  (other instance cases will have been caught in the generic).
-         --  Similarly, within an inlined body we know that the attribute
-         --  is legal in the original subprogram, and therefore legal in
-         --  the expansion.
+         --  Check for aliased view unless unrestricted case. We allow a
+         --  nonaliased prefix when within an instance because the prefix may
+         --  have been a tagged formal object, which is defined to be aliased
+         --  even when the actual might not be (other instance cases will have
+         --  been caught in the generic). Similarly, within an inlined body we
+         --  know that the attribute is legal in the original subprogram, and
+         --  therefore legal in the expansion.
 
          if Aname /= Name_Unrestricted_Access
            and then not Is_Aliased_View (P)
            and then not In_Instance
            and then not In_Inlined_Body
          then
-            Error_Attr ("prefix of % attribute must be aliased", P);
+            Error_Attr_P ("prefix of % attribute must be aliased");
          end if;
       end Analyze_Access_Attribute;
 
@@ -788,7 +864,7 @@ package body Sem_Attr is
                --  recovery behavior.
 
                Error_Msg_Name_1 := Aname;
-               Error_Msg_N
+               Error_Msg_F
                  ("prefix for % attribute must be constrained array", P);
             end if;
 
@@ -796,15 +872,14 @@ package body Sem_Attr is
 
          else
             if Is_Private_Type (P_Type) then
-               Error_Attr
-                 ("prefix for % attribute may not be private type", P);
+               Error_Attr_P ("prefix for % attribute may not be private type");
 
             elsif Is_Access_Type (P_Type)
               and then Is_Array_Type (Designated_Type (P_Type))
               and then Is_Entity_Name (P)
               and then Is_Type (Entity (P))
             then
-               Error_Attr ("prefix of % attribute cannot be access type", P);
+               Error_Attr_P ("prefix of % attribute cannot be access type");
 
             elsif Attr_Id = Attribute_First
                     or else
@@ -813,7 +888,7 @@ package body Sem_Attr is
                Error_Attr ("invalid prefix for % attribute", P);
 
             else
-               Error_Attr ("prefix for % attribute must be array", P);
+               Error_Attr_P ("prefix for % attribute must be array");
             end if;
          end if;
 
@@ -888,8 +963,7 @@ package body Sem_Attr is
                and then
               Ekind (Entity (Selector_Name (P))) /= E_Discriminant)
          then
-            Error_Attr
-              ("prefix for % attribute must be selected component", P);
+            Error_Attr_P ("prefix for % attribute must be selected component");
          end if;
       end Check_Component;
 
@@ -902,8 +976,7 @@ package body Sem_Attr is
          Check_Type;
 
          if not Is_Decimal_Fixed_Point_Type (P_Type) then
-            Error_Attr
-              ("prefix of % attribute must be decimal type", P);
+            Error_Attr_P ("prefix of % attribute must be decimal type");
          end if;
       end Check_Decimal_Fixed_Point_Type;
 
@@ -958,7 +1031,7 @@ package body Sem_Attr is
          Check_Type;
 
          if not Is_Discrete_Type (P_Type) then
-            Error_Attr ("prefix of % attribute must be discrete type", P);
+            Error_Attr_P ("prefix of % attribute must be discrete type");
          end if;
       end Check_Discrete_Type;
 
@@ -1054,7 +1127,7 @@ package body Sem_Attr is
          Check_Type;
 
          if not Is_Fixed_Point_Type (P_Type) then
-            Error_Attr ("prefix of % attribute must be fixed point type", P);
+            Error_Attr_P ("prefix of % attribute must be fixed point type");
          end if;
       end Check_Fixed_Point_Type;
 
@@ -1077,7 +1150,7 @@ package body Sem_Attr is
          Check_Type;
 
          if not Is_Floating_Point_Type (P_Type) then
-            Error_Attr ("prefix of % attribute must be float type", P);
+            Error_Attr_P ("prefix of % attribute must be float type");
          end if;
       end Check_Floating_Point_Type;
 
@@ -1120,7 +1193,7 @@ package body Sem_Attr is
          Check_Type;
 
          if not Is_Integer_Type (P_Type) then
-            Error_Attr ("prefix of % attribute must be integer type", P);
+            Error_Attr_P ("prefix of % attribute must be integer type");
          end if;
       end Check_Integer_Type;
 
@@ -1131,7 +1204,7 @@ package body Sem_Attr is
       procedure Check_Library_Unit is
       begin
          if not Is_Compilation_Unit (Entity (P)) then
-            Error_Attr ("prefix of % attribute must be library unit", P);
+            Error_Attr_P ("prefix of % attribute must be library unit");
          end if;
       end Check_Library_Unit;
 
@@ -1144,8 +1217,8 @@ package body Sem_Attr is
          Check_Type;
 
          if not Is_Modular_Integer_Type (P_Type) then
-            Error_Attr
-              ("prefix of % attribute must be modular integer type", P);
+            Error_Attr_P
+              ("prefix of % attribute must be modular integer type");
          end if;
       end Check_Modular_Integer_Type;
 
@@ -1188,8 +1261,8 @@ package body Sem_Attr is
             end loop;
 
             if From_With_Type (Etype (E)) then
-               Error_Attr
-                 ("prefix of % attribute cannot be an incomplete type", P);
+               Error_Attr_P
+                 ("prefix of % attribute cannot be an incomplete type");
 
             else
                if Is_Access_Type (Etype (E)) then
@@ -1201,8 +1274,8 @@ package body Sem_Attr is
                if Ekind (Typ) = E_Incomplete_Type
                  and then No (Full_View (Typ))
                then
-                  Error_Attr
-                    ("prefix of % attribute cannot be an incomplete type", P);
+                  Error_Attr_P
+                    ("prefix of % attribute cannot be an incomplete type");
                end if;
             end if;
          end if;
@@ -1242,7 +1315,7 @@ package body Sem_Attr is
          --  Otherwise we must have an object reference
 
          elsif not Is_Object_Reference (P) then
-            Error_Attr ("prefix of % attribute must be object", P);
+            Error_Attr_P ("prefix of % attribute must be object");
          end if;
       end Check_Object_Reference;
 
@@ -1274,7 +1347,7 @@ package body Sem_Attr is
             end;
          end if;
 
-         Error_Attr ("prefix of % attribute must be program unit", P);
+         Error_Attr_P ("prefix of % attribute must be program unit");
       end Check_Program_Unit;
 
       ---------------------
@@ -1286,7 +1359,7 @@ package body Sem_Attr is
          Check_Type;
 
          if not Is_Real_Type (P_Type) then
-            Error_Attr ("prefix of % attribute must be real type", P);
+            Error_Attr_P ("prefix of % attribute must be real type");
          end if;
       end Check_Real_Type;
 
@@ -1299,7 +1372,7 @@ package body Sem_Attr is
          Check_Type;
 
          if not Is_Scalar_Type (P_Type) then
-            Error_Attr ("prefix of % attribute must be scalar type", P);
+            Error_Attr_P ("prefix of % attribute must be scalar type");
          end if;
       end Check_Scalar_Type;
 
@@ -1443,11 +1516,12 @@ package body Sem_Attr is
 
          else
             if Ada_Version >= Ada_05 then
-               Error_Attr ("prefix of % attribute must be a task or a task "
-                           & "interface class-wide object", P);
+               Error_Attr_P
+                 ("prefix of % attribute must be a task or a task " &
+                  "interface class-wide object");
 
             else
-               Error_Attr ("prefix of % attribute must be a task", P);
+               Error_Attr_P ("prefix of % attribute must be a task");
             end if;
          end if;
       end Check_Task_Prefix;
@@ -1465,7 +1539,7 @@ package body Sem_Attr is
          if not Is_Entity_Name (P)
            or else not Is_Type (Entity (P))
          then
-            Error_Attr ("prefix of % attribute must be a type", P);
+            Error_Attr_P ("prefix of % attribute must be a type");
 
          elsif Ekind (Entity (P)) = E_Incomplete_Type
             and then Present (Full_View (Entity (P)))
@@ -1513,6 +1587,17 @@ package body Sem_Attr is
          Error_Attr;
       end Error_Attr;
 
+      ------------------
+      -- Error_Attr_P --
+      ------------------
+
+      procedure Error_Attr_P (Msg : String) is
+      begin
+         Error_Msg_Name_1 := Aname;
+         Error_Msg_F (Msg, P);
+         Error_Attr;
+      end Error_Attr_P;
+
       ----------------------------
       -- Legal_Formal_Attribute --
       ----------------------------
@@ -1524,7 +1609,7 @@ package body Sem_Attr is
          if not Is_Entity_Name (P)
            or else not Is_Type (Entity (P))
          then
-            Error_Attr ("prefix of % attribute must be generic type", N);
+            Error_Attr_P ("prefix of % attribute must be generic type");
 
          elsif Is_Generic_Actual_Type (Entity (P))
            or else In_Instance
@@ -1534,13 +1619,13 @@ package body Sem_Attr is
 
          elsif Is_Generic_Type (Entity (P)) then
             if not Is_Indefinite_Subtype (Entity (P)) then
-               Error_Attr
-                 ("prefix of % attribute must be indefinite generic type", N);
+               Error_Attr_P
+                 ("prefix of % attribute must be indefinite generic type");
             end if;
 
          else
-            Error_Attr
-              ("prefix of % attribute must be indefinite generic type", N);
+            Error_Attr_P
+              ("prefix of % attribute must be indefinite generic type");
          end if;
 
          Set_Etype (N, Standard_Boolean);
@@ -1674,7 +1759,7 @@ package body Sem_Attr is
          raise Bad_Attribute;
       end if;
 
-      --  Deal with Ada 83 and Features issues
+      --  Deal with Ada 83 issues
 
       if Comes_From_Source (N) then
          if not Attribute_83 (Attr_Id) then
@@ -1689,6 +1774,12 @@ package body Sem_Attr is
          end if;
       end if;
 
+      --  Deal with Ada 2005 issues
+
+      if Attribute_05 (Attr_Id) and then Ada_Version <= Ada_95 then
+         Check_Restriction (No_Implementation_Attributes, N);
+      end if;
+
       --   Remote access to subprogram type access attribute reference needs
       --   unanalyzed copy for tree transformation. The analyzed copy is used
       --   for its semantic information (whether prefix is a remote subprogram
@@ -1899,45 +1990,25 @@ package body Sem_Attr is
 
             begin
                if Is_Subprogram (Ent) then
-                  if not Is_Library_Level_Entity (Ent)
-
-                     --  Do not take into account nodes generated by the
-                     --  expander for the elaboration of the dispatch tables;
-                     --  otherwise we erroneously generate warnings indicating
-                     --  violation of restriction No_Implicit_Dynamic_Code
-                     --  with those nodes.
-
-                    and then not (Is_Dispatching_Operation (Ent)
-                       and then Nkind (Parent (N)) = N_Assignment_Statement
-                       and then Nkind (Name (Parent (N))) = N_Indexed_Component
-                       and then Nkind (Prefix (Name (Parent (N)))) =
-                                  N_Selected_Component
-                       and then Nkind (Selector_Name
-                                        (Prefix (Name (Parent (N))))) =
-                                  N_Identifier
-                       and then Present (Entity (Selector_Name
-                                                 (Prefix (Name (Parent (N))))))
-                       and then Entity (Selector_Name
-                                         (Prefix (Name (Parent (N))))) =
-                                  RTE_Record_Component (RE_Prims_Ptr))
-                  then
+                  if not Is_Library_Level_Entity (Ent) then
                      Check_Restriction (No_Implicit_Dynamic_Code, P);
                   end if;
 
                   Set_Address_Taken (Ent);
+                  Kill_Current_Values (Ent);
 
-                  --  An Address attribute is accepted when generated by
-                  --  the compiler for dispatching operation, and an error
-                  --  is issued once the subprogram is frozen (to avoid
-                  --  confusing errors about implicit uses of Address in
-                  --  the dispatch table initialization).
+                  --  An Address attribute is accepted when generated by the
+                  --  compiler for dispatching operation, and an error is
+                  --  issued once the subprogram is frozen (to avoid confusing
+                  --  errors about implicit uses of Address in the dispatch
+                  --  table initialization).
 
                   if Is_Always_Inlined (Entity (P))
                     and then Comes_From_Source (P)
                   then
-                     Error_Attr
+                     Error_Attr_P
                        ("prefix of % attribute cannot be Inline_Always" &
-                        " subprogram", P);
+                        " subprogram");
                   end if;
 
                elsif Is_Object (Ent)
@@ -2083,7 +2154,7 @@ package body Sem_Attr is
 
          procedure Bad_AST_Entry is
          begin
-            Error_Attr ("prefix for % attribute must be task entry", P);
+            Error_Attr_P ("prefix for % attribute must be task entry");
          end Bad_AST_Entry;
 
          function OK_Entry (E : Entity_Id) return Boolean is
@@ -2099,8 +2170,7 @@ package body Sem_Attr is
             if Result then
                if not Is_AST_Entry (E) then
                   Error_Msg_Name_2 := Aname;
-                  Error_Attr
-                    ("% attribute requires previous % pragma", P);
+                  Error_Attr ("% attribute requires previous % pragma", P);
                end if;
             end if;
 
@@ -2195,14 +2265,14 @@ package body Sem_Attr is
            and then not Is_Scalar_Type (Typ)
            and then not Is_Generic_Type (Typ)
          then
-            Error_Msg_N ("prefix of Base attribute must be scalar type", N);
+            Error_Attr_P ("prefix of Base attribute must be scalar type");
 
          elsif Sloc (Typ) = Standard_Location
            and then Base_Type (Typ) = Typ
            and then Warn_On_Redundant_Constructs
          then
-            Error_Msg_NE
-              ("?redudant attribute, & is its own base type", N, Typ);
+               Error_Msg_NE
+                 ("?redudant attribute, & is its own base type", N, Typ);
          end if;
 
          Set_Etype (N, Base_Type (Entity (P)));
@@ -2248,7 +2318,7 @@ package body Sem_Attr is
          Check_E0;
 
          if not Is_Object_Reference (P) then
-            Error_Attr ("prefix for % attribute must be object", P);
+            Error_Attr_P ("prefix for % attribute must be object");
 
          --  What about the access object cases ???
 
@@ -2269,7 +2339,7 @@ package body Sem_Attr is
          Check_Type;
 
          if not Is_Record_Type (P_Type) then
-            Error_Attr ("prefix of % attribute must be record type", P);
+            Error_Attr_P ("prefix of % attribute must be record type");
          end if;
 
          if Bytes_Big_Endian xor Reverse_Bit_Order (P_Type) then
@@ -2408,6 +2478,14 @@ package body Sem_Attr is
               or else Is_Interface (Etype (E1))
             then
                Analyze_And_Resolve (N, Etype (P));
+
+               --  However, the attribute is a name that occurs in a context
+               --  that imposes its own type. Leave the result unanalyzed,
+               --  so that type checking with the context type take place.
+               --  on the new conversion node, otherwise Resolve is a noop.
+
+               Set_Analyzed (N, False);
+
             else
                Analyze (N);
             end if;
@@ -2417,7 +2495,6 @@ package body Sem_Attr is
          else
             Find_Type (N);
          end if;
-
       end Class;
 
       ------------------
@@ -2552,8 +2629,8 @@ package body Sem_Attr is
 
          --  Fall through if bad prefix
 
-         Error_Attr
-           ("prefix of % attribute must be object of discriminated type", P);
+         Error_Attr_P
+           ("prefix of % attribute must be object of discriminated type");
 
       ---------------
       -- Copy_Sign --
@@ -2749,8 +2826,8 @@ package body Sem_Attr is
          if not Is_Floating_Point_Type (P_Type)
            and then not Is_Decimal_Fixed_Point_Type (P_Type)
          then
-            Error_Attr
-              ("prefix of % attribute must be float or decimal type", P);
+            Error_Attr_P
+              ("prefix of % attribute must be float or decimal type");
          end if;
 
          Set_Etype (N, Universal_Integer);
@@ -2812,9 +2889,9 @@ package body Sem_Attr is
                          and then
                        Ekind (Entity (P)) /= E_Enumeration_Literal)
             then
-               Error_Attr
+               Error_Attr_P
                  ("prefix of %attribute must be " &
-                  "discrete type/object or enum literal", P);
+                  "discrete type/object or enum literal");
             end if;
          end if;
 
@@ -2849,7 +2926,7 @@ package body Sem_Attr is
          Set_Etype (N, Standard_String);
 
          if not Is_Tagged_Type (P_Type) then
-            Error_Attr ("prefix of % attribute must be tagged", P);
+            Error_Attr_P ("prefix of % attribute must be tagged");
          end if;
 
       -----------
@@ -2946,11 +3023,12 @@ package body Sem_Attr is
 
          else
             if Ada_Version >= Ada_05 then
-               Error_Attr ("prefix of % attribute must be an exception, a "
-                         & "task or a task interface class-wide object", P);
+               Error_Attr_P
+                 ("prefix of % attribute must be an exception, a " &
+                  "task or a task interface class-wide object");
             else
-               Error_Attr ("prefix of % attribute must be a task or an "
-                         & "exception", P);
+               Error_Attr_P
+                 ("prefix of % attribute must be a task or an exception");
             end if;
          end if;
 
@@ -2992,8 +3070,8 @@ package body Sem_Attr is
          if not Is_Scalar_Type (P_Type)
            or else (Is_Entity_Name (P) and then Is_Type (Entity (P)))
          then
-            Error_Attr
-              ("prefix of % attribute must be scalar object name", N);
+            Error_Attr_P
+              ("prefix of % attribute must be scalar object name");
          end if;
 
          Check_Enum_Image;
@@ -3184,7 +3262,7 @@ package body Sem_Attr is
          if not Is_Entity_Name (P)
            or else not Is_Subprogram (Entity (P))
          then
-            Error_Attr ("prefix of % attribute must be subprogram", P);
+            Error_Attr_P ("prefix of % attribute must be subprogram");
          end if;
 
          Check_Either_E0_Or_E1;
@@ -3405,8 +3483,8 @@ package body Sem_Attr is
 
          if P_Type /= Any_Type then
             if not Is_Library_Level_Entity (Entity (P)) then
-               Error_Attr
-                 ("prefix of % attribute must be library-level entity", P);
+               Error_Attr_P
+                 ("prefix of % attribute must be library-level entity");
 
             --  The defining entity of prefix should not be declared inside
             --  a Pure unit. RM E.1(8).
@@ -3415,8 +3493,8 @@ package body Sem_Attr is
             elsif Is_Entity_Name (P)
               and then Is_Pure (Entity (P))
             then
-               Error_Attr
-                 ("prefix of % attribute must not be declared pure", P);
+               Error_Attr_P
+                 ("prefix of % attribute must not be declared pure");
             end if;
          end if;
 
@@ -3505,7 +3583,7 @@ package body Sem_Attr is
          then
             Resolve (P, Etype (P));
          else
-            Error_Attr ("prefix of % attribute must be a protected object", P);
+            Error_Attr_P ("prefix of % attribute must be a protected object");
          end if;
 
          Set_Etype (N, Standard_Integer);
@@ -3718,7 +3796,7 @@ package body Sem_Attr is
             null;
 
          else
-            Error_Attr ("invalid prefix for % attribute", P);
+            Error_Attr_P ("invalid prefix for % attribute");
          end if;
 
          Check_Not_Incomplete_Type;
@@ -3742,8 +3820,8 @@ package body Sem_Attr is
             Check_E0;
 
             if Ekind (P_Type) = E_Access_Subprogram_Type then
-               Error_Attr
-                 ("cannot use % attribute for access-to-subprogram type", P);
+               Error_Attr_P
+                 ("cannot use % attribute for access-to-subprogram type");
             end if;
 
             --  Set appropriate entity
@@ -3763,7 +3841,7 @@ package body Sem_Attr is
             Validate_Remote_Access_To_Class_Wide_Type (N);
 
          else
-            Error_Attr ("prefix of % attribute must be access type", P);
+            Error_Attr_P ("prefix of % attribute must be access type");
          end if;
 
       ------------------
@@ -3777,8 +3855,8 @@ package body Sem_Attr is
 
          elsif Is_Access_Type (P_Type) then
             if Ekind (P_Type) = E_Access_Subprogram_Type then
-               Error_Attr
-                 ("cannot use % attribute for access-to-subprogram type", P);
+               Error_Attr_P
+                 ("cannot use % attribute for access-to-subprogram type");
             end if;
 
             if Is_Entity_Name (P)
@@ -3804,8 +3882,7 @@ package body Sem_Attr is
             end if;
 
          else
-            Error_Attr
-              ("prefix of % attribute must be access or task type", P);
+            Error_Attr_P ("prefix of % attribute must be access or task type");
          end if;
 
       ------------------
@@ -3828,7 +3905,7 @@ package body Sem_Attr is
          then
             Set_Etype (N, Universal_Integer);
          else
-            Error_Attr ("invalid prefix for % attribute", P);
+            Error_Attr_P ("invalid prefix for % attribute");
          end if;
 
       ---------------
@@ -3843,8 +3920,8 @@ package body Sem_Attr is
             Rewrite (N,
               New_Occurrence_Of (Corresponding_Stub_Type (P_Type), Loc));
          else
-            Error_Attr
-              ("prefix of% attribute must be remote access to classwide", P);
+            Error_Attr_P
+              ("prefix of% attribute must be remote access to classwide");
          end if;
 
       ----------
@@ -3881,7 +3958,7 @@ package body Sem_Attr is
          Check_Dereference;
 
          if not Is_Tagged_Type (P_Type) then
-            Error_Attr ("prefix of % attribute must be tagged", P);
+            Error_Attr_P ("prefix of % attribute must be tagged");
 
          --  Next test does not apply to generated code
          --  why not, and what does the illegal reference mean???
@@ -3890,11 +3967,18 @@ package body Sem_Attr is
            and then not Is_Class_Wide_Type (P_Type)
            and then Comes_From_Source (N)
          then
-            Error_Attr
-              ("% attribute can only be applied to objects of class-wide type",
-               P);
+            Error_Attr_P
+              ("% attribute can only be applied to objects " &
+               "of class - wide type");
          end if;
 
+         --  The prefix cannot be an incomplete type. However, references
+         --  to 'Tag can be generated when expanding interface conversions,
+         --  and this is legal.
+
+         if Comes_From_Source (N) then
+            Check_Not_Incomplete_Type;
+         end if;
          Set_Etype (N, RTE (RE_Tag));
 
       -----------------
@@ -3941,7 +4025,7 @@ package body Sem_Attr is
          if Nkind (P) /= N_Identifier
            or else Chars (P) /= Name_System
          then
-            Error_Attr ("prefix of %attribute must be System", P);
+            Error_Attr_P ("prefix of %attribute must be System");
          end if;
 
          Generate_Reference (RTE (RE_Address), P);
@@ -4024,7 +4108,7 @@ package body Sem_Attr is
          if not Is_Entity_Name (P)
            or else Ekind (Entity (P)) not in Named_Kind
          then
-            Error_Attr ("prefix for % attribute must be named number", P);
+            Error_Attr_P ("prefix for % attribute must be named number");
 
          else
             declare
@@ -4125,7 +4209,7 @@ package body Sem_Attr is
          end if;
 
          if not Is_Scalar_Type (P_Type) then
-            Error_Attr ("object for % attribute must be of scalar type", P);
+            Error_Attr_P ("object for % attribute must be of scalar type");
          end if;
 
          Set_Etype (N, Standard_Boolean);
@@ -6946,6 +7030,26 @@ package body Sem_Attr is
           and then Associated_Node_For_Itype (Anon) = Parent (Typ);
    end Is_Anonymous_Tagged_Base;
 
+   --------------------------
+   -- Name_Modifies_Prefix --
+   --------------------------
+
+   function Name_Modifies_Prefix (Nam : Name_Id) return Boolean is
+      pragma Assert (Is_Attribute_Name (Nam));
+   begin
+      return Attribute_Name_Modifies_Prefix (Get_Attribute_Id (Nam));
+   end Name_Modifies_Prefix;
+
+   ---------------------------------
+   -- Requires_Simple_Name_Prefix --
+   ---------------------------------
+
+   function Requires_Simple_Name_Prefix (Nam : Name_Id) return Boolean is
+      pragma Assert (Is_Attribute_Name (Nam));
+   begin
+      return Attribute_Requires_Simple_Name_Prefix (Get_Attribute_Id (Nam));
+   end Requires_Simple_Name_Prefix;
+
    -----------------------
    -- Resolve_Attribute --
    -----------------------
@@ -6977,9 +7081,9 @@ package body Sem_Attr is
          --  know will fail, so generate an appropriate warning.
 
          if In_Instance_Body then
-            Error_Msg_N
+            Error_Msg_F
               ("?non-local pointer cannot point to local object", P);
-            Error_Msg_N
+            Error_Msg_F
               ("\?Program_Error will be raised at run time", P);
             Rewrite (N,
               Make_Raise_Program_Error (Loc,
@@ -6988,7 +7092,7 @@ package body Sem_Attr is
             return;
 
          else
-            Error_Msg_N
+            Error_Msg_F
               ("non-local pointer cannot point to local object", P);
 
             --  Check for case where we have a missing access definition
@@ -7009,8 +7113,8 @@ package body Sem_Attr is
                if Present (Indic) then
                   Error_Msg_NE
                     ("\use an access definition for" &
-                      " the access discriminant of&", N,
-                         Entity (Subtype_Mark (Indic)));
+                     " the access discriminant of&",
+                     N, Entity (Subtype_Mark (Indic)));
                end if;
             end if;
          end if;
@@ -7106,24 +7210,20 @@ package body Sem_Attr is
                elsif Is_Overloadable (Entity (P))
                  and then Is_Abstract_Subprogram (Entity (P))
                then
-                  Error_Msg_N ("prefix of % attribute cannot be abstract", P);
+                  Error_Msg_F ("prefix of % attribute cannot be abstract", P);
                   Set_Etype (N, Any_Type);
 
                elsif Convention (Entity (P)) = Convention_Intrinsic then
                   if Ekind (Entity (P)) = E_Enumeration_Literal then
-                     Error_Msg_N
+                     Error_Msg_F
                        ("prefix of % attribute cannot be enumeration literal",
-                          P);
+                        P);
                   else
-                     Error_Msg_N
+                     Error_Msg_F
                        ("prefix of % attribute cannot be intrinsic", P);
                   end if;
 
                   Set_Etype (N, Any_Type);
-
-               elsif Is_Thread_Body (Entity (P)) then
-                  Error_Msg_N
-                    ("prefix of % attribute cannot be a thread body", P);
                end if;
 
                --  Assignments, return statements, components of aggregates,
@@ -7138,9 +7238,21 @@ package body Sem_Attr is
                     or else
                   Ekind (Btyp) = E_Anonymous_Access_Protected_Subprogram_Type
                then
+                  --  Deal with convention mismatch
+
                   if Convention (Btyp) /= Convention (Entity (P)) then
-                     Error_Msg_N
-                      ("subprogram has invalid convention for context", P);
+                     Error_Msg_FE
+                       ("subprogram & has wrong convention", P, Entity (P));
+
+                     Error_Msg_FE
+                       ("\does not match convention of access type &",
+                        P, Btyp);
+
+                     if not Has_Convention_Pragma (Btyp) then
+                        Error_Msg_FE
+                          ("\probable missing pragma Convention for &",
+                           P, Btyp);
+                     end if;
 
                   else
                      Check_Subtype_Conformant
@@ -7151,7 +7263,7 @@ package body Sem_Attr is
 
                   if Attr_Id = Attribute_Unchecked_Access then
                      Error_Msg_Name_1 := Aname;
-                     Error_Msg_N
+                     Error_Msg_F
                        ("attribute% cannot be applied to a subprogram", P);
 
                   elsif Aname = Name_Unrestricted_Access then
@@ -7171,7 +7283,7 @@ package body Sem_Attr is
                     and then Ekind (Btyp) /=
                                E_Anonymous_Access_Protected_Subprogram_Type
                   then
-                     Error_Msg_N
+                     Error_Msg_F
                        ("subprogram must not be deeper than access type", P);
 
                   --  Check the restriction of 3.10.2(32) that disallows the
@@ -7210,8 +7322,8 @@ package body Sem_Attr is
                   --  want the check to apply when the access attribute is in
                   --  the spec and there's some other generic body enclosing
                   --  generic). Finally, there's no point applying the check
-                  --  when within an instance, because any violations will
-                  --  have been caught by the compilation of the generic unit.
+                  --  when within an instance, because any violations will have
+                  --  been caught by the compilation of the generic unit.
 
                   elsif Attr_Id = Attribute_Access
                     and then not In_Instance
@@ -7306,7 +7418,7 @@ package body Sem_Attr is
 
                if Attr_Id = Attribute_Unchecked_Access then
                   Error_Msg_Name_1 := Aname;
-                  Error_Msg_N
+                  Error_Msg_F
                     ("attribute% cannot be applied to protected operation", P);
                end if;
 
@@ -7340,16 +7452,17 @@ package body Sem_Attr is
                Resolve (P);
             end if;
 
-            --  X'Access is illegal if X denotes a constant and the access
-            --  type is access-to-variable. Same for 'Unchecked_Access.
-            --  The rule does not apply to 'Unrestricted_Access.
-            --  If the reference is a default-initialized aggregate component
-            --  for a self-referential type the reference is legal.
+            --  X'Access is illegal if X denotes a constant and the access type
+            --  is access-to-variable. Same for 'Unchecked_Access. The rule
+            --  does not apply to 'Unrestricted_Access. If the reference is a
+            --  default-initialized aggregate component for a self-referential
+            --  type the reference is legal.
 
             if not (Ekind (Btyp) = E_Access_Subprogram_Type
                      or else Ekind (Btyp) = E_Anonymous_Access_Subprogram_Type
-                     or else (Is_Record_Type (Btyp) and then
-                              Present (Corresponding_Remote_Type (Btyp)))
+                    or else (Is_Record_Type (Btyp)
+                              and then
+                                Present (Corresponding_Remote_Type (Btyp)))
                      or else Ekind (Btyp) = E_Access_Protected_Subprogram_Type
                      or else Ekind (Btyp)
                                = E_Anonymous_Access_Protected_Subprogram_Type
@@ -7366,7 +7479,7 @@ package body Sem_Attr is
                   null;
 
                elsif Comes_From_Source (N) then
-                  Error_Msg_N ("access-to-variable designates constant", P);
+                  Error_Msg_F ("access-to-variable designates constant", P);
                end if;
             end if;
 
@@ -7377,14 +7490,12 @@ package body Sem_Attr is
                           or else Ekind (Btyp) = E_Anonymous_Access_Type)
             then
                --  Ada 2005 (AI-230): Check the accessibility of anonymous
-               --  access types in record and array components. For a
-               --  component definition the level is the same of the
-               --  enclosing composite type.
+               --  access types for stand-alone objects, record and array
+               --  components, and return objects. For a component definition
+               --  the level is the same of the enclosing composite type.
 
                if Ada_Version >= Ada_05
-                 and then
-                   (Is_Local_Anonymous_Access (Btyp)
-                      or else Ekind (Scope (Btyp)) = E_Return_Statement)
+                 and then Is_Local_Anonymous_Access (Btyp)
                  and then Object_Access_Level (P) > Type_Access_Level (Btyp)
                  and then Attr_Id = Attribute_Access
                then
@@ -7392,22 +7503,23 @@ package body Sem_Attr is
                   --  know will fail, so generate an appropriate warning.
 
                   if In_Instance_Body then
-                     Error_Msg_N
+                     Error_Msg_F
                        ("?non-local pointer cannot point to local object", P);
-                     Error_Msg_N
+                     Error_Msg_F
                        ("\?Program_Error will be raised at run time", P);
                      Rewrite (N,
                        Make_Raise_Program_Error (Loc,
                          Reason => PE_Accessibility_Check_Failed));
                      Set_Etype (N, Typ);
+
                   else
-                     Error_Msg_N
+                     Error_Msg_F
                        ("non-local pointer cannot point to local object", P);
                   end if;
                end if;
 
                if Is_Dependent_Component_Of_Mutable_Object (P) then
-                  Error_Msg_N
+                  Error_Msg_F
                     ("illegal attribute for discriminant-dependent component",
                      P);
                end if;
@@ -7419,7 +7531,7 @@ package body Sem_Attr is
                Nom_Subt := Etype (P);
 
                if Is_Constr_Subt_For_U_Nominal (Nom_Subt) then
-                  Nom_Subt := Etype (Nom_Subt);
+                  Nom_Subt := Base_Type (Nom_Subt);
                end if;
 
                Des_Btyp := Designated_Type (Btyp);
@@ -7463,10 +7575,10 @@ package body Sem_Attr is
                               null;
 
                            else
-                              Error_Msg_NE
+                              Error_Msg_FE
                                 ("type of prefix: & not compatible",
                                   P, Nom_Subt);
-                              Error_Msg_NE
+                              Error_Msg_FE
                                 ("\with &, the expected designated type",
                                   P, Designated_Type (Typ));
                            end if;
@@ -7478,9 +7590,9 @@ package body Sem_Attr is
                       (not Is_Class_Wide_Type (Designated_Type (Typ))
                         and then Is_Class_Wide_Type (Nom_Subt))
                   then
-                     Error_Msg_NE
+                     Error_Msg_FE
                        ("type of prefix: & is not covered", P, Nom_Subt);
-                     Error_Msg_NE
+                     Error_Msg_FE
                        ("\by &, the expected designated type" &
                            " ('R'M 3.10.2 (27))", P, Designated_Type (Typ));
                   end if;
@@ -7511,7 +7623,7 @@ package body Sem_Attr is
                                 not Has_Constrained_Partial_View
                                       (Designated_Type (Base_Type (Typ)))))
                then
-                  Error_Msg_N
+                  Error_Msg_F
                     ("object subtype must statically match "
                      & "designated subtype", P);
 
@@ -7552,17 +7664,19 @@ package body Sem_Attr is
                if Is_Entity_Name (P)
                  and then not Is_Protected_Type (Scope (Entity (P)))
                then
-                  Error_Msg_N ("context requires a protected subprogram", P);
+                  Error_Msg_F ("context requires a protected subprogram", P);
 
                --  Check accessibility of protected object against that
                --  of the access type, but only on user code, because
                --  the expander creates access references for handlers.
                --  If the context is an anonymous_access_to_protected,
                --  there are no accessibility checks either.
+               --  Omit check altogether for GNAT Unrestricted_Access.
 
                elsif Object_Access_Level (P) > Type_Access_Level (Btyp)
                  and then Comes_From_Source (N)
                  and then Ekind (Btyp) = E_Access_Protected_Subprogram_Type
+                 and then Attr_Id /= Attribute_Unrestricted_Access
                then
                   Accessibility_Message;
                   return;
@@ -7573,7 +7687,7 @@ package body Sem_Attr is
                    Ekind (Btyp) = E_Anonymous_Access_Subprogram_Type)
               and then Ekind (Etype (N)) = E_Access_Protected_Subprogram_Type
             then
-               Error_Msg_N ("context requires a non-protected subprogram", P);
+               Error_Msg_F ("context requires a non-protected subprogram", P);
             end if;
 
             --  The context cannot be a pool-specific type, but this is a
@@ -7586,7 +7700,12 @@ package body Sem_Attr is
                Wrong_Type (N, Typ);
             end if;
 
-            Set_Etype (N, Typ);
+            --  The context may be a constrained access type (however ill-
+            --  advised such subtypes might be) so in order to generate a
+            --  constraint check when needed set the type of the attribute
+            --  reference to the base type of the context.
+
+            Set_Etype (N, Btyp);
 
             --  Check for incorrect atomic/volatile reference (RM C.6(12))
 
@@ -7594,14 +7713,14 @@ package body Sem_Attr is
                if Is_Atomic_Object (P)
                  and then not Is_Atomic (Designated_Type (Typ))
                then
-                  Error_Msg_N
+                  Error_Msg_F
                     ("access to atomic object cannot yield access-to-" &
                      "non-atomic type", P);
 
                elsif Is_Volatile_Object (P)
                  and then not Is_Volatile (Designated_Type (Typ))
                then
-                  Error_Msg_N
+                  Error_Msg_F
                     ("access to volatile object cannot yield access-to-" &
                      "non-volatile type", P);
                end if;
@@ -7631,9 +7750,8 @@ package body Sem_Attr is
 
                if Present (It.Nam) then
                   Error_Msg_Name_1 := Aname;
-                  Error_Msg_N
+                  Error_Msg_F
                     ("prefix of % attribute cannot be overloaded", P);
-                  return;
                end if;
             end if;
 
@@ -7994,9 +8112,23 @@ package body Sem_Attr is
       end case;
 
       --  Normally the Freezing is done by Resolve but sometimes the Prefix
-      --  is not resolved, in which case the freezing must be done now.
+      --  is not resolved, in which case the freezing must be done now. The
+      --  exception to this general rule is the use of 'Address with
+      --  subprograms (this is required by the backend to support the static
+      --  allocation of the dispatch tables).
+
+      if Static_Dispatch_Tables
+        and then Nkind (P) in N_Has_Entity
+        and then not Is_Frozen (Entity (P))
+        and then Attr_Id = Attribute_Address
+        and then Is_Subprogram (Entity (P))
+        and then Is_Dispatching_Operation (Entity (P))
+      then
+         Set_Has_Delayed_Freeze (Entity (P));
 
-      Freeze_Expression (P);
+      else
+         Freeze_Expression (P);
+      end if;
 
       --  Finally perform static evaluation on the attribute reference
 

gcc/ada/sem_attr.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, 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- --
@@ -32,6 +32,7 @@
 --  This spec also documents all GNAT implementation defined pragmas
 
 with Exp_Tss; use Exp_Tss;
+with Namet;   use Namet;
 with Snames;  use Snames;
 with Types;   use Types;
 
@@ -541,6 +542,19 @@ package Sem_Attr is
    --  in appropriate contexts (i.e. in subtype marks, or as prefixes for
    --  other attributes).
 
+   function Name_Modifies_Prefix (Nam : Name_Id) return Boolean;
+   --  Determine whether the name of an attribute reference modifies the
+   --  contents of its prefix. "Read" is such an attribute.
+
+   function Requires_Simple_Name_Prefix (Nam : Name_Id) return Boolean;
+   --  Determine whether the name of an attribute reference requires a simple
+   --  name rather than a value as its prefix. Such prefixes do not need to be
+   --  optimized. For instance in the following example:
+   --     I : constant Integer := 5;
+   --     S : constant Integer := I'Size;
+   --  "Size" requires a simple name prefix since "5'Size" does not make
+   --  sense.
+
    procedure Resolve_Attribute (N : Node_Id; Typ : Entity_Id);
    --  Performs type resolution of attribute. If the attribute yields a
    --  universal value, mark its type as that of the context. On the other