[multiple changes]

2012-07-12  Robert Dewar  <dewar@adacore.com>

	* exp_attr.adb, exp_ch9.adb, sem_ch9.adb, exp_aggr.adb: Minor
	reformatting.

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

	* sem_dim.adb (Analyze_Dimension_Function_Call): Reformatting of error
	msgs for elementary functions.

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

	* sem_attr.adb (Eval_Attribute): Minor reformatting.

2012-07-12  Pascal Obry  <obry@adacore.com>

	* prj-nmsc.adb (Check_Library_Attributes): Allow the same library
	project in different project tree (different aggregated projects).

2012-07-12  Thomas Quinot  <quinot@adacore.com>

	* s-bytswa.adb, g-bytswa.adb, g-bytswa.ads, s-bytswa.ads: Further
	reorganization of byte swapping routines.

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

	* sem_disp.adb (Check_Dispatching_Context): Refine legality
	checks on tagg indeterminate calls to abstract operations,
	that appear in the context of other calls.

From-SVN: r189436

gcc/ada/ChangeLog

@@ -1,3 +1,33 @@
+2012-07-12  Robert Dewar  <dewar@adacore.com>
+
+	* exp_attr.adb, exp_ch9.adb, sem_ch9.adb, exp_aggr.adb: Minor
+	reformatting.
+
+2012-07-12  Vincent Pucci  <pucci@adacore.com>
+
+	* sem_dim.adb (Analyze_Dimension_Function_Call): Reformatting of error
+	msgs for elementary functions.
+
+2012-07-12  Vincent Pucci  <pucci@adacore.com>
+
+	* sem_attr.adb (Eval_Attribute): Minor reformatting.
+
+2012-07-12  Pascal Obry  <obry@adacore.com>
+
+	* prj-nmsc.adb (Check_Library_Attributes): Allow the same library
+	project in different project tree (different aggregated projects).
+
+2012-07-12  Thomas Quinot  <quinot@adacore.com>
+
+	* s-bytswa.adb, g-bytswa.adb, g-bytswa.ads, s-bytswa.ads: Further
+	reorganization of byte swapping routines.
+
+2012-07-12  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_disp.adb (Check_Dispatching_Context): Refine legality
+	checks on tagg indeterminate calls to abstract operations,
+	that appear in the context of other calls.
+
 2012-07-12  Thomas Quinot  <quinot@adacore.com>
 
 	* s-bytswa.adb (Swapped2.Bswap16): Remove local function,

gcc/ada/exp_aggr.adb

@@ -294,8 +294,8 @@ package body Exp_Aggr is
 
       --  The normal limit is 5000, but we increase this limit to 2**24 (about
       --  16 million) if Restrictions (No_Elaboration_Code) or Restrictions
-      --  (No_Implicit_Loops) is specified, since in either case we are at risk
+      --  (No_Implicit_Loops) is specified, since in either case we are at
-      --  of declaring the program illegal because of this limit. We also
+      --  risk of declaring the program illegal because of this limit. We also
       --  increase the limit when Static_Elaboration_Desired, given that this
       --  means that objects are intended to be placed in data memory.
 
@@ -3517,9 +3517,9 @@ package body Exp_Aggr is
                            --  Check for maximum others replication. Note that
                            --  we skip this test if either of the restrictions
                            --  No_Elaboration_Code or No_Implicit_Loops is
-                           --  active, if this is a preelaborable unit or a
+                           --  active, if this is a preelaborable unit or
-                           --  predefined unit, or if the unit must be placed
+                           --  a predefined unit, or if the unit must be
-                           --  in data memory. This also ensures that
+                           --  placed in data memory. This also ensures that
                            --  predefined units get the same level of constant
                            --  folding in Ada 95 and Ada 2005, where their
                            --  categorization has changed.
@@ -3537,7 +3537,8 @@ package body Exp_Aggr is
                                 or else
                                   (Ekind (Current_Scope) = E_Package
                                     and then
-                                    Static_Elaboration_Desired (Current_Scope))
+                                      Static_Elaboration_Desired
+                                        (Current_Scope))
                                 or else Is_Preelaborated (P)
                                 or else (Ekind (P) = E_Package_Body
                                           and then
@@ -3746,11 +3747,13 @@ package body Exp_Aggr is
                         and then Ekind (Entity (Expr)) = E_Enumeration_Literal)
                   then
                      null;
+
                   else
-                     Error_Msg_N ("non-static object "
+                     Error_Msg_N
-                       & " requires elaboration code?", N);
+                       ("non-static object  requires elaboration code?", N);
                      exit;
                   end if;
+
                   Next (Expr);
                end loop;
 

gcc/ada/exp_attr.adb

@@ -816,9 +816,9 @@ package body Exp_Attr is
 
       if Is_Protected_Self_Reference (Pref)
         and then not
-             (Nkind_In (Parent (N), N_Index_Or_Discriminant_Constraint,
+          (Nkind_In (Parent (N), N_Index_Or_Discriminant_Constraint,
-                                    N_Discriminant_Association)
+                                 N_Discriminant_Association)
-                and then Nkind (Parent (Parent (Parent (Parent (N))))) =
+            and then Nkind (Parent (Parent (Parent (Parent (N))))) =
                                                       N_Component_Definition)
 
          --  No action needed for these attributes since the current instance

gcc/ada/exp_ch9.adb

@@ -3084,7 +3084,7 @@ package body Exp_Ch9 is
       --  protected component.
 
       if Present (Comp) then
-         declare
+         Protected_Component_Ref : declare
             Comp_Decl    : constant Node_Id   := Parent (Comp);
             Comp_Sel_Nam : constant Node_Id   := Name (Comp_Decl);
             Comp_Type    : constant Entity_Id := Etype (Comp);
@@ -3220,7 +3220,6 @@ package body Exp_Ch9 is
 
             procedure Process_Stmts (Stmts : List_Id) is
                Stmt : Node_Id;
-
             begin
                Stmt := First (Stmts);
                while Present (Stmt) loop
@@ -3229,6 +3228,8 @@ package body Exp_Ch9 is
                end loop;
             end Process_Stmts;
 
+         --  Start of processing for Protected_Component_Ref
+
          begin
             --  Get the type size
 
@@ -3436,23 +3437,24 @@ package body Exp_Ch9 is
             --    end loop;
 
             if Is_Procedure then
-               Stmts := New_List (
+               Stmts :=
-                 Make_Procedure_Call_Statement (Loc,
+                 New_List (
-                    Name =>
+                   Make_Procedure_Call_Statement (Loc,
-                      New_Reference_To (RTE (RE_Atomic_Synchronize), Loc)),
+                      Name =>
-                 Make_Loop_Statement (Loc,
+                        New_Reference_To (RTE (RE_Atomic_Synchronize), Loc)),
-                   Statements => New_List (
+                   Make_Loop_Statement (Loc,
-                     Make_Block_Statement (Loc,
+                     Statements => New_List (
-                       Declarations               => Block_Decls,
+                       Make_Block_Statement (Loc,
-                       Handled_Statement_Sequence =>
+                         Declarations               => Block_Decls,
-                         Make_Handled_Sequence_Of_Statements (Loc,
+                         Handled_Statement_Sequence =>
-                           Statements => Stmts))),
+                           Make_Handled_Sequence_Of_Statements (Loc,
-                   End_Label  => Empty));
+                             Statements => Stmts))),
+                     End_Label  => Empty));
             end if;
 
             Hand_Stmt_Seq :=
               Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts);
-         end;
+         end Protected_Component_Ref;
       end if;
 
       --  Make an unprotected version of the subprogram for use within the same

gcc/ada/g-bytswa.adb

@@ -2,11 +2,11 @@
 --                                                                          --
 --                         GNAT RUN-TIME COMPONENTS                         --
 --                                                                          --
---                     G N A T . B Y T E _ S W A P P I N G                  --
+--                    G N A T . B Y T E _ S W A P P I N G                   --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 1995-2012, AdaCore                     --
+--                     Copyright (C) 2006-2012, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -29,8 +29,85 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This package does not require a body, since it is a package renaming. We
+--  This is a general implementation that uses GCC intrinsics to take
---  provide a dummy file containing a No_Body pragma so that previous versions
+--  advantage of any machine-specific instructions.
---  of the body (which did exist) will not interfere.
 
-pragma No_Body;
+with Ada.Unchecked_Conversion; use Ada;
+
+with System.Byte_Swapping; use System.Byte_Swapping;
+
+package body GNAT.Byte_Swapping is
+
+   --------------
+   -- Swapped2 --
+   --------------
+
+   function Swapped2 (Input : Item) return Item is
+      function As_U16 is new Unchecked_Conversion (Item, U16);
+      function As_Item is new Unchecked_Conversion (U16, Item);
+      pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 2,
+        "storage size must be 2 bytes");
+   begin
+      return As_Item (Bswap_16 (As_U16 (Input)));
+   end Swapped2;
+
+   --------------
+   -- Swapped4 --
+   --------------
+
+   function Swapped4 (Input : Item) return Item is
+      function As_U32 is new Unchecked_Conversion (Item, U32);
+      function As_Item is new Unchecked_Conversion (U32, Item);
+      pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 4,
+        "storage size must be 4 bytes");
+   begin
+      return As_Item (Bswap_32 (As_U32 (Input)));
+   end Swapped4;
+
+   --------------
+   -- Swapped8 --
+   --------------
+
+   function Swapped8 (Input : Item) return Item is
+      function As_U64 is new Unchecked_Conversion (Item, U64);
+      function As_Item is new Unchecked_Conversion (U64, Item);
+      pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 8,
+        "storage size must be 8 bytes");
+   begin
+      return As_Item (Bswap_64 (As_U64 (Input)));
+   end Swapped8;
+
+   -----------
+   -- Swap2 --
+   -----------
+
+   procedure Swap2 (Location : System.Address) is
+      X : U16;
+      for X'Address use Location;
+   begin
+      X := Bswap_16 (X);
+   end Swap2;
+
+   -----------
+   -- Swap4 --
+   -----------
+
+   procedure Swap4 (Location : System.Address) is
+      X : U32;
+      for X'Address use Location;
+   begin
+      X := Bswap_32 (X);
+   end Swap4;
+
+   -----------
+   -- Swap8 --
+   -----------
+
+   procedure Swap8 (Location : System.Address) is
+      X : U64;
+      for X'Address use Location;
+   begin
+      X := Bswap_64 (X);
+   end Swap8;
+
+end GNAT.Byte_Swapping;

gcc/ada/g-bytswa.ads

@@ -2,7 +2,7 @@
 --                                                                          --
 --                         GNAT RUN-TIME COMPONENTS                         --
 --                                                                          --
---                     G N A T . B Y T E _ S W A P P I N G                  --
+--                    G N A T . B Y T E _ S W A P P I N G                   --
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
@@ -31,8 +31,176 @@
 
 --  Simple routines for swapping the bytes of 16-, 32-, and 64-bit objects
 
---  See file s-bytswa.ads for full documentation of the interface
+--  The generic functions should be instantiated with types that are of a size
+--  in bytes corresponding to the name of the generic. For example, a 2-byte
+--  integer type would be compatible with Swapped2, 4-byte integer with
+--  Swapped4, and so on. Failure to do so will result in a warning when
+--  compiling the instantiation; this warning should be heeded. Ignoring this
+--  warning can result in unexpected results.
 
-with System.Byte_Swapping;
+--  An example of proper usage follows:
 
-package GNAT.Byte_Swapping renames System.Byte_Swapping;
+--     declare
+--        type Short_Integer is range -32768 .. 32767;
+--        for Short_Integer'Size use 16; -- for confirmation
+
+--        X : Short_Integer := 16#7FFF#;
+
+--        function Swapped is new Byte_Swapping.Swapped2 (Short_Integer);
+
+--     begin
+--        Put_Line (X'Img);
+--        X := Swapped (X);
+--        Put_Line (X'Img);
+--     end;
+
+--  Note that the generic actual types need not be scalars, but must be
+--  'definite' types. They can, for example, be constrained subtypes of
+--  unconstrained array types as long as the size is correct. For instance,
+--  a subtype of String with length of 4 would be compatible with the
+--  Swapped4 generic:
+
+--     declare
+--        subtype String4 is String (1 .. 4);
+--        function Swapped is new Byte_Swapping.Swapped4 (String4);
+--        S : String4 := "ABCD";
+--        for S'Alignment use 4;
+--     begin
+--        Put_Line (S);
+--        S := Swapped (S);
+--        Put_Line (S);
+--     end;
+
+--  Similarly, a constrained array type is also acceptable:
+
+--     declare
+--        type Mask is array (0 .. 15) of Boolean;
+--        for Mask'Alignment use 2;
+--        for Mask'Component_Size use Boolean'Size;
+--        X : Mask := (0 .. 7 => True, others => False);
+--        function Swapped is new Byte_Swapping.Swapped2 (Mask);
+--     begin
+--        ...
+--        X := Swapped (X);
+--        ...
+--     end;
+
+--  A properly-sized record type will also be acceptable, and so forth
+
+--  However, as described, a size mismatch must be avoided. In the following we
+--  instantiate one of the generics with a type that is too large. The result
+--  of the function call is undefined, such that assignment to an object can
+--  result in garbage values.
+
+--     Wrong: declare
+--        subtype String16 is String (1 .. 16);
+
+--        function Swapped is new Byte_Swapping.Swapped8 (String16);
+--        --  Instantiation generates a compiler warning about
+--        --  mismatched sizes
+
+--        S : String16;
+
+--     begin
+--        S := "ABCDEFGHDEADBEEF";
+--
+--        Put_Line (S);
+--
+--        --  the following assignment results in garbage in S after the
+--        --  first 8 bytes
+--
+--        S := Swapped (S);
+--
+--        Put_Line (S);
+--     end Wrong;
+
+--  When the size of the type is larger than 8 bytes, the use of the non-
+--  generic procedures is an alternative because no function result is
+--  involved; manipulation of the object is direct.
+
+--  The procedures are passed the address of an object to manipulate. They will
+--  swap the first N bytes of that object corresponding to the name of the
+--  procedure.  For example:
+
+--     declare
+--        S2 : String := "AB";
+--        for S2'Alignment use 2;
+--        S4 : String := "ABCD";
+--        for S4'Alignment use 4;
+--        S8 : String := "ABCDEFGH";
+--        for S8'Alignment use 8;
+
+--     begin
+--        Swap2 (S2'Address);
+--        Put_Line (S2);
+
+--        Swap4 (S4'Address);
+--        Put_Line (S4);
+
+--        Swap8 (S8'Address);
+--        Put_Line (S8);
+--     end;
+
+--  If an object of a type larger than N is passed, the remaining bytes of the
+--  object are undisturbed. For example:
+
+--     declare
+--        subtype String16 is String (1 .. 16);
+
+--        S : String16;
+--        for S'Alignment use 8;
+
+--     begin
+--        S  := "ABCDEFGHDEADBEEF";
+--        Put_Line (S);
+--        Swap8 (S'Address);
+--        Put_Line (S);
+--     end;
+
+with System;
+
+package GNAT.Byte_Swapping is
+   pragma Pure;
+
+   --  NB: all the routines in this package treat the application objects as
+   --  unsigned (modular) types of a size in bytes corresponding to the routine
+   --  name. For example, the generic function Swapped2 manipulates the object
+   --  passed to the formal parameter Input as a value of an unsigned type that
+   --  is 2 bytes long. Therefore clients are responsible for the compatibility
+   --  of application types manipulated by these routines and these modular
+   --  types, in terms of both size and alignment. This requirement applies to
+   --  the generic actual type passed to the generic formal type Item in the
+   --  generic functions, as well as to the type of the object implicitly
+   --  designated by the address passed to the non-generic procedures. Use of
+   --  incompatible types can result in implementation- defined effects.
+
+   generic
+      type Item is limited private;
+   function Swapped2 (Input : Item) return Item;
+   --  Return the 2-byte value of Input with the bytes swapped
+
+   generic
+      type Item is limited private;
+   function Swapped4 (Input : Item) return Item;
+   --  Return the 4-byte value of Input with the bytes swapped
+
+   generic
+      type Item is limited private;
+   function Swapped8 (Input : Item) return Item;
+   --  Return the 8-byte value of Input with the bytes swapped
+
+   procedure Swap2 (Location : System.Address);
+   --  Swap the first 2 bytes of the object starting at the address specified
+   --  by Location.
+
+   procedure Swap4 (Location : System.Address);
+   --  Swap the first 4 bytes of the object starting at the address specified
+   --  by Location.
+
+   procedure Swap8 (Location : System.Address);
+   --  Swap the first 8 bytes of the object starting at the address specified
+   --  by Location.
+
+   pragma Inline (Swap2, Swap4, Swap8, Swapped2, Swapped4, Swapped8);
+
+end GNAT.Byte_Swapping;

gcc/ada/prj-nmsc.adb

@@ -165,6 +165,7 @@ package body Prj.Nmsc is
    type Lib_Data is record
       Name : Name_Id;
       Proj : Project_Id;
+      Tree : Project_Tree_Ref;
    end record;
 
    package Lib_Data_Table is new GNAT.Table
@@ -3639,7 +3640,9 @@ package body Prj.Nmsc is
          --  Check if the same library name is used in an other library project
 
          for J in 1 .. Lib_Data_Table.Last loop
-            if Lib_Data_Table.Table (J).Name = Project.Library_Name then
+            if Lib_Data_Table.Table (J).Name = Project.Library_Name
+              and then Lib_Data_Table.Table (J).Tree = Data.Tree
+            then
                Error_Msg_Name_1 := Lib_Data_Table.Table (J).Proj.Name;
                Error_Msg
                  (Data.Flags,
@@ -3656,7 +3659,9 @@ package body Prj.Nmsc is
          --  Record the library name
 
          Lib_Data_Table.Append
-           ((Name => Project.Library_Name, Proj => Project));
+           ((Name => Project.Library_Name,
+             Proj => Project,
+             Tree => Data.Tree));
       end if;
    end Check_Library_Attributes;
 

gcc/ada/s-bytswa.adb

@@ -1,124 +0,0 @@
-------------------------------------------------------------------------------
---                                                                          --
---                         GNAT RUN-TIME COMPONENTS                         --
---                                                                          --
---                  S Y S T E M . B Y T E _ S W A P P I N G                 --
---                                                                          --
---                                 B o d y                                  --
---                                                                          --
---                     Copyright (C) 2006-2012, AdaCore                     --
---                                                                          --
--- 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- --
--- ware  Foundation;  either version 3,  or (at your option) any later ver- --
--- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
---                                                                          --
--- As a special exception under Section 7 of GPL version 3, you are granted --
--- additional permissions described in the GCC Runtime Library Exception,   --
--- version 3.1, as published by the Free Software Foundation.               --
---                                                                          --
--- You should have received a copy of the GNU General Public License and    --
--- a copy of the GCC Runtime Library Exception along with this program;     --
--- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
--- <http://www.gnu.org/licenses/>.                                          --
---                                                                          --
--- GNAT was originally developed  by the GNAT team at  New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc.      --
---                                                                          --
-------------------------------------------------------------------------------
-
---  This is a general implementation that uses GCC intrinsics to take
---  advantage of any machine-specific instructions.
-
-with Ada.Unchecked_Conversion; use Ada;
-
-package body System.Byte_Swapping is
-
-   type U16 is mod 2**16;
-   type U32 is mod 2**32;
-   type U64 is mod 2**64;
-
-   function Bswap_16 (X : U16) return U16;
-   pragma Import (Intrinsic, Bswap_16, "__builtin_bswap16");
-
-   function Bswap_32 (X : U32) return U32;
-   pragma Import (Intrinsic, Bswap_32, "__builtin_bswap32");
-
-   function Bswap_64 (X : U64) return U64;
-   pragma Import (Intrinsic, Bswap_64, "__builtin_bswap64");
-
-   --------------
-   -- Swapped2 --
-   --------------
-
-   function Swapped2 (Input : Item) return Item is
-      function As_U16 is new Unchecked_Conversion (Item, U16);
-      function As_Item is new Unchecked_Conversion (U16, Item);
-      pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 2,
-        "storage size must be 2 bytes");
-   begin
-      return As_Item (Bswap_16 (As_U16 (Input)));
-   end Swapped2;
-
-   --------------
-   -- Swapped4 --
-   --------------
-
-   function Swapped4 (Input : Item) return Item is
-      function As_U32 is new Unchecked_Conversion (Item, U32);
-      function As_Item is new Unchecked_Conversion (U32, Item);
-      pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 4,
-        "storage size must be 4 bytes");
-   begin
-      return As_Item (Bswap_32 (As_U32 (Input)));
-   end Swapped4;
-
-   --------------
-   -- Swapped8 --
-   --------------
-
-   function Swapped8 (Input : Item) return Item is
-      function As_U64 is new Unchecked_Conversion (Item, U64);
-      function As_Item is new Unchecked_Conversion (U64, Item);
-      pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 8,
-        "storage size must be 8 bytes");
-   begin
-      return As_Item (Bswap_64 (As_U64 (Input)));
-   end Swapped8;
-
-   -----------
-   -- Swap2 --
-   -----------
-
-   procedure Swap2 (Location : System.Address) is
-      X : U16;
-      for X'Address use Location;
-   begin
-      X := Bswap_16 (X);
-   end Swap2;
-
-   -----------
-   -- Swap4 --
-   -----------
-
-   procedure Swap4 (Location : System.Address) is
-      X : U32;
-      for X'Address use Location;
-   begin
-      X := Bswap_32 (X);
-   end Swap4;
-
-   -----------
-   -- Swap8 --
-   -----------
-
-   procedure Swap8 (Location : System.Address) is
-      X : U64;
-      for X'Address use Location;
-   begin
-      X := Bswap_64 (X);
-   end Swap8;
-
-end System.Byte_Swapping;

gcc/ada/s-bytswa.ads

@@ -29,178 +29,24 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  Simple routines for swapping the bytes of 16-, 32-, and 64-bit objects
+--  Supporting routines for GNAT.Byte_Swapping, also used directly by
-
+--  expended code.
---  The generic functions should be instantiated with types that are of a size
---  in bytes corresponding to the name of the generic. For example, a 2-byte
---  integer type would be compatible with Swapped2, 4-byte integer with
---  Swapped4, and so on. Failure to do so will result in a warning when
---  compiling the instantiation; this warning should be heeded. Ignoring this
---  warning can result in unexpected results.
-
---  An example of proper usage follows:
-
---     declare
---        type Short_Integer is range -32768 .. 32767;
---        for Short_Integer'Size use 16; -- for confirmation
-
---        X : Short_Integer := 16#7FFF#;
-
---        function Swapped is new Byte_Swapping.Swapped2 (Short_Integer);
-
---     begin
---        Put_Line (X'Img);
---        X := Swapped (X);
---        Put_Line (X'Img);
---     end;
-
---  Note that the generic actual types need not be scalars, but must be
---  'definite' types. They can, for example, be constrained subtypes of
---  unconstrained array types as long as the size is correct. For instance,
---  a subtype of String with length of 4 would be compatible with the
---  Swapped4 generic:
-
---     declare
---        subtype String4 is String (1 .. 4);
---        function Swapped is new Byte_Swapping.Swapped4 (String4);
---        S : String4 := "ABCD";
---        for S'Alignment use 4;
---     begin
---        Put_Line (S);
---        S := Swapped (S);
---        Put_Line (S);
---     end;
-
---  Similarly, a constrained array type is also acceptable:
-
---     declare
---        type Mask is array (0 .. 15) of Boolean;
---        for Mask'Alignment use 2;
---        for Mask'Component_Size use Boolean'Size;
---        X : Mask := (0 .. 7 => True, others => False);
---        function Swapped is new Byte_Swapping.Swapped2 (Mask);
---     begin
---        ...
---        X := Swapped (X);
---        ...
---     end;
-
---  A properly-sized record type will also be acceptable, and so forth
-
---  However, as described, a size mismatch must be avoided. In the following we
---  instantiate one of the generics with a type that is too large. The result
---  of the function call is undefined, such that assignment to an object can
---  result in garbage values.
-
---     Wrong: declare
---        subtype String16 is String (1 .. 16);
-
---        function Swapped is new Byte_Swapping.Swapped8 (String16);
---        --  Instantiation generates a compiler warning about
---        --  mismatched sizes
-
---        S : String16;
-
---     begin
---        S := "ABCDEFGHDEADBEEF";
---
---        Put_Line (S);
---
---        --  the following assignment results in garbage in S after the
---        --  first 8 bytes
---
---        S := Swapped (S);
---
---        Put_Line (S);
---     end Wrong;
-
---  When the size of the type is larger than 8 bytes, the use of the non-
---  generic procedures is an alternative because no function result is
---  involved; manipulation of the object is direct.
-
---  The procedures are passed the address of an object to manipulate. They will
---  swap the first N bytes of that object corresponding to the name of the
---  procedure.  For example:
-
---     declare
---        S2 : String := "AB";
---        for S2'Alignment use 2;
---        S4 : String := "ABCD";
---        for S4'Alignment use 4;
---        S8 : String := "ABCDEFGH";
---        for S8'Alignment use 8;
-
---     begin
---        Swap2 (S2'Address);
---        Put_Line (S2);
-
---        Swap4 (S4'Address);
---        Put_Line (S4);
-
---        Swap8 (S8'Address);
---        Put_Line (S8);
---     end;
-
---  If an object of a type larger than N is passed, the remaining bytes of the
---  object are undisturbed. For example:
-
---     declare
---        subtype String16 is String (1 .. 16);
-
---        S : String16;
---        for S'Alignment use 8;
-
---     begin
---        S  := "ABCDEFGHDEADBEEF";
---        Put_Line (S);
---        Swap8 (S'Address);
---        Put_Line (S);
---     end;
-
-with System;
 
 package System.Byte_Swapping is
+
    pragma Pure;
 
-   --  NB: all the routines in this package treat the application objects as
+   type U16 is mod 2**16;
-   --  unsigned (modular) types of a size in bytes corresponding to the routine
+   type U32 is mod 2**32;
-   --  name. For example, the generic function Swapped2 manipulates the object
+   type U64 is mod 2**64;
-   --  passed to the formal parameter Input as a value of an unsigned type that
-   --  is 2 bytes long. Therefore clients are responsible for the compatibility
-   --  of application types manipulated by these routines and these modular
-   --  types, in terms of both size and alignment. This requirement applies to
-   --  the generic actual type passed to the generic formal type Item in the
-   --  generic functions, as well as to the type of the object implicitly
-   --  designated by the address passed to the non-generic procedures. Use of
-   --  incompatible types can result in implementation- defined effects.
 
-   generic
+   function Bswap_16 (X : U16) return U16;
-      type Item is limited private;
+   pragma Import (Intrinsic, Bswap_16, "__builtin_bswap16");
-   function Swapped2 (Input : Item) return Item;
-   --  Return the 2-byte value of Input with the bytes swapped
 
-   generic
+   function Bswap_32 (X : U32) return U32;
-      type Item is limited private;
+   pragma Import (Intrinsic, Bswap_32, "__builtin_bswap32");
-   function Swapped4 (Input : Item) return Item;
-   --  Return the 4-byte value of Input with the bytes swapped
 
-   generic
+   function Bswap_64 (X : U64) return U64;
-      type Item is limited private;
+   pragma Import (Intrinsic, Bswap_64, "__builtin_bswap64");
-   function Swapped8 (Input : Item) return Item;
-   --  Return the 8-byte value of Input with the bytes swapped
-
-   procedure Swap2 (Location : System.Address);
-   --  Swap the first 2 bytes of the object starting at the address specified
-   --  by Location.
-
-   procedure Swap4 (Location : System.Address);
-   --  Swap the first 4 bytes of the object starting at the address specified
-   --  by Location.
-
-   procedure Swap8 (Location : System.Address);
-   --  Swap the first 8 bytes of the object starting at the address specified
-   --  by Location.
-
-   pragma Inline (Swap2, Swap4, Swap8, Swapped2, Swapped4, Swapped8);
 
 end System.Byte_Swapping;

gcc/ada/sem_attr.adb

@@ -6322,11 +6322,12 @@ package body Sem_Attr is
               Attribute_Iterator_Element     |
               Attribute_Variable_Indexing    => null;
 
-         --  Atributes related to Ada 2012 aspects
+         --  Internal attributes used to deal with Ada 2012 delayed aspects.
+         --  These were already rejected by the parser. Thus they shouldn't
+         --  appear here.
 
-         when Attribute_CPU                |
+         when Internal_Attribute_Id =>
-              Attribute_Dispatching_Domain |
+            raise Program_Error;
-              Attribute_Interrupt_Priority => null;
 
       --------------
       -- Adjacent --

gcc/ada/sem_ch9.adb

@@ -175,7 +175,6 @@ package body Sem_Ch9 is
 
                   begin
                      Par := First (Par_Specs);
-
                      while Present (Par) loop
                         if Out_Present (Par)
                           and then not Is_Elementary_Type
@@ -183,10 +182,9 @@ package body Sem_Ch9 is
                         then
                            if Complain then
                               Error_Msg_NE
-                                ("non-elementary out parameter& not allowed " &
+                                ("non-elementary out parameter& not allowed "
-                                 "when Lock_Free given",
+                                 & "when Lock_Free given",
-                                 Par,
+                                 Par, Defining_Identifier (Par));
-                                 Defining_Identifier (Par));
                            end if;
 
                            return False;

gcc/ada/sem_dim.adb

@@ -1585,8 +1585,7 @@ package body Sem_Dim is
                   Dims_Of_Actual := Dimensions_Of (Actual);
 
                   if Exists (Dims_Of_Actual) then
-                     Error_Msg_NE ("parameter should be dimensionless for " &
+                     Error_Msg_NE ("parameter of& must be dimensionless",
-                                   "elementary function&",
                                    Actual, Name_Call);
                      Error_Msg_N ("\parameter " & Dimensions_Msg_Of (Actual),
                                   Actual);

gcc/ada/sem_disp.adb

@@ -493,8 +493,34 @@ package body Sem_Disp is
 
       procedure Check_Dispatching_Context is
          Subp : constant Entity_Id := Entity (Name (N));
+         Typ  : constant Entity_Id := Etype (Subp);
          Par  : Node_Id;
 
+         procedure Abstract_Context_Error;
+         --  Indicate that the abstract call that dispatches on result is not
+         --  dispatching.
+
+         -----------------------------
+         --  Bastract_Context_Error --
+         -----------------------------
+
+         procedure Abstract_Context_Error is
+         begin
+            if Ekind (Subp) = E_Function then
+               Error_Msg_N
+                 ("call to abstract function must be dispatching", N);
+
+            --  This error can occur for a procedure in the case of a
+            --  call to an abstract formal procedure with a statically
+            --  tagged operand.
+
+            else
+               Error_Msg_N
+                 ("call to abstract procedure must be dispatching",
+                  N);
+            end if;
+         end Abstract_Context_Error;
+
       begin
          if Is_Abstract_Subprogram (Subp)
            and then No (Controlling_Argument (N))
@@ -510,15 +536,78 @@ package body Sem_Disp is
                return;
 
             else
+               --  We need to determine whether the context of the call
+               --  provides a tag to make the call dispatching. This requires
+               --  the call to be the actual in an enclosing call, and that
+               --  actual must be controlling.  If the call is an operand of
+               --  equality, the other operand must not ve abstract.
+
+               if not Is_Tagged_Type (Typ)
+                 and then not
+                    (Ekind (Typ) = E_Anonymous_Access_Type
+                      and then Is_Tagged_Type (Designated_Type (Typ)))
+               then
+                  Abstract_Context_Error;
+                  return;
+               end if;
+
                Par := Parent (N);
+               if Nkind (Par) = N_Parameter_Association then
+                  Par := Parent (Par);
+               end if;
+
                while Present (Par) loop
-                  if Nkind_In (Par, N_Function_Call,
+                  if Nkind_In (Par,
-                                    N_Procedure_Call_Statement,
+                                 N_Function_Call,
-                                    N_Assignment_Statement,
+                                 N_Procedure_Call_Statement)
-                                    N_Op_Eq,
+                    and then Is_Entity_Name (Name (Par))
-                                    N_Op_Ne)
-                    and then Is_Tagged_Type (Etype (Subp))
                   then
+                     declare
+                        A : Node_Id;
+                        F : Entity_Id;
+
+                     begin
+                        --  Find formal for which call is the actual.
+
+                        F := First_Formal (Entity (Name (Par)));
+                        A := First_Actual (Par);
+
+                        while Present (F) loop
+
+                           if Is_Controlling_Formal (F)
+                             and then
+                               (N = A or else Parent (N) = A)
+                           then
+                              return;
+                           end if;
+
+                           Next_Formal (F);
+                           Next_Actual (A);
+                        end loop;
+
+                        Error_Msg_N
+                          ("call to abstract function must be dispatching", N);
+                        return;
+                     end;
+
+                  --  For equalitiy operators, one of the operands must
+                  --  be statically or dynamically tagged.
+
+                  elsif Nkind_In (Par, N_Op_Eq, N_Op_Ne) then
+                     if N = Right_Opnd (Par)
+                       and then Is_Tag_Indeterminate (Left_Opnd (Par))
+                     then
+                        Abstract_Context_Error;
+
+                     elsif N = Left_Opnd (Par)
+                       and then Is_Tag_Indeterminate (Right_Opnd (Par))
+                     then
+                        Abstract_Context_Error;
+                     end if;
+
+                     return;
+
+                  elsif Nkind (Par) = N_Assignment_Statement then
                      return;
 
                   elsif Nkind (Par) = N_Qualified_Expression
@@ -527,20 +616,7 @@ package body Sem_Disp is
                      Par := Parent (Par);
 
                   else
-                     if Ekind (Subp) = E_Function then
+                     Abstract_Context_Error;
-                        Error_Msg_N
-                          ("call to abstract function must be dispatching", N);
-
-                     --  This error can occur for a procedure in the case of a
-                     --  call to an abstract formal procedure with a statically
-                     --  tagged operand.
-
-                     else
-                        Error_Msg_N
-                          ("call to abstract procedure must be dispatching",
-                           N);
-                     end if;
-
                      return;
                   end if;
                end loop;