[multiple changes]

2010-10-25  Pascal Obry  <obry@adacore.com>
	
	* adaint.c (__gnat_file_time_name_attr): Use GetFileAttributesEx to get
	the timestamp. A bit faster than opening/closing the file.
	(__gnat_stat_to_attr): Remove kludge for Windows.
	(__gnat_file_exists_attr): Likewise.
	The timestamp is now retreived using GetFileAttributesEx as faster.

2010-10-25  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Derive_Interface_Subprogram): New subprogram.
	(Derive_Subprograms): For abstract private types transfer to the full
	view entities of uncovered interface primitives. Required because if
	the interface primitives are left in the private part of the package
	they will be decorated as hidden when the analysis of the enclosing
	package completes (and hence the interface primitive is not visible
	for dispatching calls).

2010-10-25  Matthew Heaney  <heaney@adacore.com>

	* Makefile.rtl, impunit.adb: Added bounded set and bounded map
	containers.
	* a-crbltr.ads: Added declaration of generic package for bounded tree
	types.
	* a-rbtgbo.ads, a-rbtgbo.adb, a-rbtgbk.ads, a-rbtgbk.adb, a-btgbso.ads,
	a-btgbso.adb, a-cborse.ads, a-cborse.adb, a-cborma.ads, a-cborma.adb:
	New.

2010-10-25  Thomas Quinot  <quinot@adacore.com>

	* sem_util.adb: Minor reformatting.
	* usage.adb: Fix usage line for -gnatwh.

2010-10-25  Thomas Quinot  <quinot@adacore.com>

	* sem_ch12.adb (Analyze_Package_Instantiation): For an
	instantiation in an RCI spec, omit package body if instantiation comes
	from source, even as a nested
	package.
	* exp_dist.adb (Add_Calling_Stubs_To_Declarations,
	*_Support.Add_Receiving_Stubs_To_Declarations): Handle the case of
	nested packages, package instantiations and subprogram instantiations.

From-SVN: r165920

gcc/ada/ChangeLog

+2010-10-25  Pascal Obry  <obry@adacore.com>
+	
+	* adaint.c (__gnat_file_time_name_attr): Use GetFileAttributesEx to get
+	the timestamp. A bit faster than opening/closing the file.
+	(__gnat_stat_to_attr): Remove kludge for Windows.
+	(__gnat_file_exists_attr): Likewise.
+	The timestamp is now retreived using GetFileAttributesEx as faster.
+
+2010-10-25  Javier Miranda  <miranda@adacore.com>
+
+	* sem_ch3.adb (Derive_Interface_Subprogram): New subprogram.
+	(Derive_Subprograms): For abstract private types transfer to the full
+	view entities of uncovered interface primitives. Required because if
+	the interface primitives are left in the private part of the package
+	they will be decorated as hidden when the analysis of the enclosing
+	package completes (and hence the interface primitive is not visible
+	for dispatching calls).
+
+2010-10-25  Matthew Heaney  <heaney@adacore.com>
+
+	* Makefile.rtl, impunit.adb: Added bounded set and bounded map
+	containers.
+	* a-crbltr.ads: Added declaration of generic package for bounded tree
+	types.
+	* a-rbtgbo.ads, a-rbtgbo.adb, a-rbtgbk.ads, a-rbtgbk.adb, a-btgbso.ads,
+	a-btgbso.adb, a-cborse.ads, a-cborse.adb, a-cborma.ads, a-cborma.adb:
+	New.
+
+2010-10-25  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_util.adb: Minor reformatting.
+	* usage.adb: Fix usage line for -gnatwh.
+
+2010-10-25  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch12.adb (Analyze_Package_Instantiation): For an
+	instantiation in an RCI spec, omit package body if instantiation comes
+	from source, even as a nested
+	package.
+	* exp_dist.adb (Add_Calling_Stubs_To_Declarations,
+	*_Support.Add_Receiving_Stubs_To_Declarations): Handle the case of
+	nested packages, package instantiations and subprogram instantiations.
+
 2010-10-25  Robert Dewar  <dewar@adacore.com>
 
 	* exp_ch5.adb (Expand_Predicated_Loop): Remove code for loop through

gcc/ada/Makefile.rtl

@@ -79,12 +79,15 @@ GNATRTL_TASKING_OBJS= \
 # Objects needed for non-tasking.
 GNATRTL_NONTASKING_OBJS= \
   a-assert$(objext) \
+  a-btgbso$(objext) \
   a-calari$(objext) \
   a-calcon$(objext) \
   a-caldel$(objext) \
   a-calend$(objext) \
   a-calfor$(objext) \
   a-catizo$(objext) \
+  a-cborse$(objext) \
+  a-cborma$(objext) \
   a-cdlili$(objext) \
   a-cgaaso$(objext) \
   a-cgarso$(objext) \
@@ -180,6 +183,8 @@ GNATRTL_NONTASKING_OBJS= \
   a-nuflra$(objext) \
   a-numaux$(objext) \
   a-numeri$(objext) \
+  a-rbtgbo$(objext) \
+  a-rbtgbk$(objext) \
   a-rbtgso$(objext) \
   a-scteio$(objext) \
   a-secain$(objext) \

gcc/ada/a-btgbso.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--       ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_BOUNDED_SET_OPERATIONS      --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- 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/>.                                          --
+--                                                                          --
+-- This unit was originally developed by Matthew J Heaney.                  --
+------------------------------------------------------------------------------
+
+--  Tree_Type is used to implement ordered containers. This package declares
+--  set-based tree operations.
+
+with Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations;
+
+generic
+   with package Tree_Operations is new Generic_Bounded_Operations (<>);
+
+   type Set_Type is new Tree_Operations.Tree_Types.Tree_Type with private;
+
+   use Tree_Operations.Tree_Types;
+
+   with procedure Assign (Target : in out Set_Type; Source : Set_Type);
+
+   with procedure Insert_With_Hint
+     (Dst_Set  : in out Set_Type;
+      Dst_Hint : Count_Type;
+      Src_Node : Node_Type;
+      Dst_Node : out Count_Type);
+
+   with function Is_Less (Left, Right : Node_Type) return Boolean;
+
+package Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations is
+   pragma Pure;
+
+   procedure Set_Union (Target : in out Set_Type; Source : Set_Type);
+   --  Attempts to insert each element of Source in Target. If Target is
+   --  busy then Program_Error is raised. We say "attempts" here because
+   --  if these are unique-element sets, then the insertion should fail
+   --  (not insert a new item) when the insertion item from Source is
+   --  equivalent to an item already in Target. If these are multisets
+   --  then of course the attempt should always succeed.
+
+   function Set_Union (Left, Right : Set_Type) return Set_Type;
+   --  Makes a copy of Left, and attempts to insert each element of
+   --  Right into the copy, then returns the copy.
+
+   procedure Set_Intersection (Target : in out Set_Type; Source : Set_Type);
+   --  Removes elements from Target that are not equivalent to items in
+   --  Source. If Target is busy then Program_Error is raised.
+
+   function Set_Intersection (Left, Right : Set_Type) return Set_Type;
+   --  Returns a set comprising all the items in Left equivalent to items in
+   --  Right.
+
+   procedure Set_Difference (Target : in out Set_Type; Source : Set_Type);
+   --  Removes elements from Target that are equivalent to items in Source. If
+   --  Target is busy then Program_Error is raised.
+
+   function Set_Difference (Left, Right : Set_Type) return Set_Type;
+   --  Returns a set comprising all the items in Left not equivalent to items
+   --  in Right.
+
+   procedure Set_Symmetric_Difference
+     (Target : in out Set_Type;
+      Source : Set_Type);
+   --  Removes from Target elements that are equivalent to items in Source,
+   --  and inserts into Target items from Source not equivalent elements in
+   --  Target. If Target is busy then Program_Error is raised.
+
+   function Set_Symmetric_Difference (Left, Right : Set_Type) return Set_Type;
+   --  Returns a set comprising the union of the elements in Left not
+   --  equivalent to items in Right, and the elements in Right not equivalent
+   --  to items in Left.
+
+   function Set_Subset (Subset : Set_Type; Of_Set : Set_Type) return Boolean;
+   --  Returns False if Subset contains at least one element not equivalent to
+   --  any item in Of_Set; returns True otherwise.
+
+   function Set_Overlap (Left, Right : Set_Type) return Boolean;
+   --  Returns True if at least one element of Left is equivalent to an item in
+   --  Right; returns False otherwise.
+
+end Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations;

gcc/ada/a-cborma.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--   A D A . C O N T A I N E R S . B O U N D E D _ O R D E R E D _ M A P S  --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--                                                                          --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the  contents of the part following the private keyword. --
+--                                                                          --
+-- 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/>.                                          --
+--                                                                          --
+-- This unit was originally developed by Matthew J Heaney.                  --
+------------------------------------------------------------------------------
+
+private with Ada.Containers.Red_Black_Trees;
+private with Ada.Streams;
+
+generic
+   type Key_Type is private;
+   type Element_Type is private;
+
+   with function "<" (Left, Right : Key_Type) return Boolean is <>;
+   with function "=" (Left, Right : Element_Type) return Boolean is <>;
+
+package Ada.Containers.Bounded_Ordered_Maps is
+   pragma Pure;
+   pragma Remote_Types;
+
+   function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
+
+   type Map (Capacity : Count_Type) is tagged private;
+   pragma Preelaborable_Initialization (Map);
+
+   type Cursor is private;
+   pragma Preelaborable_Initialization (Cursor);
+
+   Empty_Map : constant Map;
+
+   No_Element : constant Cursor;
+
+   function "=" (Left, Right : Map) return Boolean;
+
+   function Length (Container : Map) return Count_Type;
+
+   function Is_Empty (Container : Map) return Boolean;
+
+   procedure Clear (Container : in out Map);
+
+   function Key (Position : Cursor) return Key_Type;
+
+   function Element (Position : Cursor) return Element_Type;
+
+   procedure Replace_Element
+     (Container : in out Map;
+      Position  : Cursor;
+      New_Item  : Element_Type);
+
+   procedure Query_Element
+     (Position : Cursor;
+      Process  : not null access
+                   procedure (Key : Key_Type; Element : Element_Type));
+
+   procedure Update_Element
+     (Container : in out Map;
+      Position  : Cursor;
+      Process   : not null access
+                   procedure (Key : Key_Type; Element : in out Element_Type));
+
+   procedure Assign (Target : in out Map; Source : Map);
+
+   function Copy (Source : Map; Capacity : Count_Type := 0) return Map;
+
+   procedure Move (Target : in out Map; Source : in out Map);
+
+   procedure Insert
+     (Container : in out Map;
+      Key       : Key_Type;
+      New_Item  : Element_Type;
+      Position  : out Cursor;
+      Inserted  : out Boolean);
+
+   procedure Insert
+     (Container : in out Map;
+      Key       : Key_Type;
+      Position  : out Cursor;
+      Inserted  : out Boolean);
+
+   procedure Insert
+     (Container : in out Map;
+      Key       : Key_Type;
+      New_Item  : Element_Type);
+
+   procedure Include
+     (Container : in out Map;
+      Key       : Key_Type;
+      New_Item  : Element_Type);
+
+   procedure Replace
+     (Container : in out Map;
+      Key       : Key_Type;
+      New_Item  : Element_Type);
+
+   procedure Exclude (Container : in out Map; Key : Key_Type);
+
+   procedure Delete (Container : in out Map; Key : Key_Type);
+
+   procedure Delete (Container : in out Map; Position : in out Cursor);
+
+   procedure Delete_First (Container : in out Map);
+
+   procedure Delete_Last (Container : in out Map);
+
+   function First (Container : Map) return Cursor;
+
+   function First_Element (Container : Map) return Element_Type;
+
+   function First_Key (Container : Map) return Key_Type;
+
+   function Last (Container : Map) return Cursor;
+
+   function Last_Element (Container : Map) return Element_Type;
+
+   function Last_Key (Container : Map) return Key_Type;
+
+   function Next (Position : Cursor) return Cursor;
+
+   procedure Next (Position : in out Cursor);
+
+   function Previous (Position : Cursor) return Cursor;
+
+   procedure Previous (Position : in out Cursor);
+
+   function Find (Container : Map; Key : Key_Type) return Cursor;
+
+   function Element (Container : Map; Key : Key_Type) return Element_Type;
+
+   function Floor (Container : Map; Key : Key_Type) return Cursor;
+
+   function Ceiling (Container : Map; Key : Key_Type) return Cursor;
+
+   function Contains (Container : Map; Key : Key_Type) return Boolean;
+
+   function Has_Element (Position : Cursor) return Boolean;
+
+   function "<" (Left, Right : Cursor) return Boolean;
+
+   function ">" (Left, Right : Cursor) return Boolean;
+
+   function "<" (Left : Cursor; Right : Key_Type) return Boolean;
+
+   function ">" (Left : Cursor; Right : Key_Type) return Boolean;
+
+   function "<" (Left : Key_Type; Right : Cursor) return Boolean;
+
+   function ">" (Left : Key_Type; Right : Cursor) return Boolean;
+
+   procedure Iterate
+     (Container : Map;
+      Process   : not null access procedure (Position : Cursor));
+
+   procedure Reverse_Iterate
+     (Container : Map;
+      Process   : not null access procedure (Position : Cursor));
+
+private
+
+   pragma Inline (Next);
+   pragma Inline (Previous);
+
+   type Node_Type is record
+      Parent  : Count_Type;
+      Left    : Count_Type;
+      Right   : Count_Type;
+      Color   : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
+      Key     : Key_Type;
+      Element : Element_Type;
+   end record;
+
+   package Tree_Types is
+     new Red_Black_Trees.Generic_Bounded_Tree_Types (Node_Type);
+
+   type Map (Capacity : Count_Type) is
+     new Tree_Types.Tree_Type (Capacity) with null record;
+
+   type Map_Access is access all Map;
+   for Map_Access'Storage_Size use 0;
+
+   use Red_Black_Trees;
+   use Tree_Types;
+   use Ada.Streams;
+
+   type Cursor is record
+      Container : Map_Access;
+      Node      : Count_Type;
+   end record;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Cursor);
+
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
+   No_Element : constant Cursor := Cursor'(null, 0);
+
+   procedure Write
+     (Stream    : not null access Root_Stream_Type'Class;
+      Container : Map);
+
+   for Map'Write use Write;
+
+   procedure Read
+     (Stream    : not null access Root_Stream_Type'Class;
+      Container : out Map);
+
+   for Map'Read use Read;
+
+   Empty_Map : constant Map := Map'(Tree_Type with Capacity => 0);
+
+end Ada.Containers.Bounded_Ordered_Maps;

gcc/ada/a-cborse.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--   A D A . C O N T A I N E R S . B O U N D E D _ O R D E R E D _ S E T S  --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--                                                                          --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the  contents of the part following the private keyword. --
+--                                                                          --
+-- 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/>.                                          --
+--                                                                          --
+-- This unit was originally developed by Matthew J Heaney.                  --
+------------------------------------------------------------------------------
+
+private with Ada.Containers.Red_Black_Trees;
+private with Ada.Streams;
+
+generic
+   type Element_Type is private;
+
+   with function "<" (Left, Right : Element_Type) return Boolean is <>;
+   with function "=" (Left, Right : Element_Type) return Boolean is <>;
+
+package Ada.Containers.Bounded_Ordered_Sets is
+   pragma Pure;
+   pragma Remote_Types;
+
+   function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
+
+   type Set (Capacity : Count_Type) is tagged private;
+   pragma Preelaborable_Initialization (Set);
+
+   type Cursor is private;
+   pragma Preelaborable_Initialization (Cursor);
+
+   Empty_Set : constant Set;
+
+   No_Element : constant Cursor;
+
+   function "=" (Left, Right : Set) return Boolean;
+
+   function Equivalent_Sets (Left, Right : Set) return Boolean;
+
+   function To_Set (New_Item : Element_Type) return Set;
+
+   function Length (Container : Set) return Count_Type;
+
+   function Is_Empty (Container : Set) return Boolean;
+
+   procedure Clear (Container : in out Set);
+
+   function Element (Position : Cursor) return Element_Type;
+
+   procedure Replace_Element
+     (Container : in out Set;
+      Position  : Cursor;
+      New_Item  : Element_Type);
+
+   procedure Query_Element
+     (Position : Cursor;
+      Process  : not null access procedure (Element : Element_Type));
+
+   procedure Assign (Target : in out Set; Source : Set);
+
+   function Copy (Source : Set; Capacity : Count_Type := 0) return Set;
+
+   procedure Move (Target : in out Set; Source : in out Set);
+
+   procedure Insert
+     (Container : in out Set;
+      New_Item  : Element_Type;
+      Position  : out Cursor;
+      Inserted  : out Boolean);
+
+   procedure Insert
+     (Container : in out Set;
+      New_Item  : Element_Type);
+
+   procedure Include
+     (Container : in out Set;
+      New_Item  : Element_Type);
+
+   procedure Replace
+     (Container : in out Set;
+      New_Item  : Element_Type);
+
+   procedure Exclude
+     (Container : in out Set;
+      Item      : Element_Type);
+
+   procedure Delete
+     (Container : in out Set;
+      Item      : Element_Type);
+
+   procedure Delete
+     (Container : in out Set;
+      Position  : in out Cursor);
+
+   procedure Delete_First (Container : in out Set);
+
+   procedure Delete_Last (Container : in out Set);
+
+   procedure Union (Target : in out Set; Source : Set);
+
+   function Union (Left, Right : Set) return Set;
+
+   function "or" (Left, Right : Set) return Set renames Union;
+
+   procedure Intersection (Target : in out Set; Source : Set);
+
+   function Intersection (Left, Right : Set) return Set;
+
+   function "and" (Left, Right : Set) return Set renames Intersection;
+
+   procedure Difference (Target : in out Set; Source : Set);
+
+   function Difference (Left, Right : Set) return Set;
+
+   function "-" (Left, Right : Set) return Set renames Difference;
+
+   procedure Symmetric_Difference (Target : in out Set; Source : Set);
+
+   function Symmetric_Difference (Left, Right : Set) return Set;
+
+   function "xor" (Left, Right : Set) return Set renames Symmetric_Difference;
+
+   function Overlap (Left, Right : Set) return Boolean;
+
+   function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
+
+   function First (Container : Set) return Cursor;
+
+   function First_Element (Container : Set) return Element_Type;
+
+   function Last (Container : Set) return Cursor;
+
+   function Last_Element (Container : Set) return Element_Type;
+
+   function Next (Position : Cursor) return Cursor;
+
+   procedure Next (Position : in out Cursor);
+
+   function Previous (Position : Cursor) return Cursor;
+
+   procedure Previous (Position : in out Cursor);
+
+   function Find (Container : Set; Item : Element_Type) return Cursor;
+
+   function Floor (Container : Set; Item : Element_Type) return Cursor;
+
+   function Ceiling (Container : Set; Item : Element_Type) return Cursor;
+
+   function Contains (Container : Set; Item : Element_Type) return Boolean;
+
+   function Has_Element (Position : Cursor) return Boolean;
+
+   function "<" (Left, Right : Cursor) return Boolean;
+
+   function ">" (Left, Right : Cursor) return Boolean;
+
+   function "<" (Left : Cursor; Right : Element_Type) return Boolean;
+
+   function ">" (Left : Cursor; Right : Element_Type) return Boolean;
+
+   function "<" (Left : Element_Type; Right : Cursor) return Boolean;
+
+   function ">" (Left : Element_Type; Right : Cursor) return Boolean;
+
+   procedure Iterate
+     (Container : Set;
+      Process   : not null access procedure (Position : Cursor));
+
+   procedure Reverse_Iterate
+     (Container : Set;
+      Process   : not null access procedure (Position : Cursor));
+
+   generic
+      type Key_Type (<>) is private;
+
+      with function Key (Element : Element_Type) return Key_Type;
+
+      with function "<" (Left, Right : Key_Type) return Boolean is <>;
+
+   package Generic_Keys is
+
+      function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
+
+      function Key (Position : Cursor) return Key_Type;
+
+      function Element (Container : Set; Key : Key_Type) return Element_Type;
+
+      procedure Replace
+        (Container : in out Set;
+         Key       : Key_Type;
+         New_Item  : Element_Type);
+
+      procedure Exclude (Container : in out Set; Key : Key_Type);
+
+      procedure Delete (Container : in out Set; Key : Key_Type);
+
+      function Find (Container : Set; Key : Key_Type) return Cursor;
+
+      function Floor (Container : Set; Key : Key_Type) return Cursor;
+
+      function Ceiling (Container : Set; Key : Key_Type) return Cursor;
+
+      function Contains (Container : Set; Key : Key_Type) return Boolean;
+
+      procedure Update_Element_Preserving_Key
+        (Container : in out Set;
+         Position  : Cursor;
+         Process   : not null access
+                       procedure (Element : in out Element_Type));
+
+   end Generic_Keys;
+
+private
+
+   pragma Inline (Next);
+   pragma Inline (Previous);
+
+   type Node_Type is record
+      Parent  : Count_Type;
+      Left    : Count_Type;
+      Right   : Count_Type;
+      Color   : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
+      Element : Element_Type;
+   end record;
+
+   package Tree_Types is
+     new Red_Black_Trees.Generic_Bounded_Tree_Types (Node_Type);
+
+   type Set (Capacity : Count_Type) is
+     new Tree_Types.Tree_Type (Capacity) with null record;
+
+   type Set_Access is access all Set;
+   for Set_Access'Storage_Size use 0;
+
+   type Cursor is record
+      Container : Set_Access;
+      Node      : Count_Type;
+   end record;
+
+   use Tree_Types;
+   use Ada.Streams;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Cursor);
+
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
+   No_Element : constant Cursor := Cursor'(null, 0);
+
+   procedure Write
+     (Stream    : not null access Root_Stream_Type'Class;
+      Container : Set);
+
+   for Set'Write use Write;
+
+   procedure Read
+     (Stream    : not null access Root_Stream_Type'Class;
+      Container : out Set);
+
+   for Set'Read use Read;
+
+   Empty_Set : constant Set := Set'(Tree_Type with Capacity => 0);
+
+end Ada.Containers.Bounded_Ordered_Sets;

gcc/ada/a-crbltr.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -48,4 +48,21 @@ package Ada.Containers.Red_Black_Trees is
       end record;
    end Generic_Tree_Types;
 
+   generic
+      type Node_Type is private;
+   package Generic_Bounded_Tree_Types is
+      type Nodes_Type is array (Count_Type range <>) of Node_Type;
+
+      type Tree_Type (Capacity : Count_Type) is tagged record
+         First  : Count_Type := 0;
+         Last   : Count_Type := 0;
+         Root   : Count_Type := 0;
+         Length : Count_Type := 0;
+         Busy   : Natural := 0;
+         Lock   : Natural := 0;
+         Free   : Count_Type'Base := -1;
+         Nodes  : Nodes_Type (1 .. Capacity);
+      end record;
+   end Generic_Bounded_Tree_Types;
+
 end Ada.Containers.Red_Black_Trees;

gcc/ada/a-rbtgbk.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--            ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_BOUNDED_KEYS           --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- 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/>.                                          --
+--                                                                          --
+-- This unit was originally developed by Matthew J Heaney.                  --
+------------------------------------------------------------------------------
+
+--  Tree_Type is used to implement ordered containers. This package declares
+--  the tree operations that depend on keys.
+
+with Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations;
+
+generic
+   with package Tree_Operations is new Generic_Bounded_Operations (<>);
+
+   use Tree_Operations.Tree_Types;
+
+   type Key_Type (<>) is limited private;
+
+   with function Is_Less_Key_Node
+     (L : Key_Type;
+      R : Node_Type) return Boolean;
+
+   with function Is_Greater_Key_Node
+     (L : Key_Type;
+      R : Node_Type) return Boolean;
+
+package Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys is
+   pragma Pure;
+
+   generic
+      with function New_Node return Count_Type;
+
+   procedure Generic_Insert_Post
+     (Tree   : in out Tree_Type'Class;
+      Y      : Count_Type;
+      Before : Boolean;
+      Z      : out Count_Type);
+   --  Completes an insertion after the insertion position has been
+   --  determined. On output Z contains the index of the newly inserted
+   --  node, allocated using Allocate. If Tree is busy then
+   --  Program_Error is raised. If Y is 0, then Tree must be empty.
+   --  Otherwise Y denotes the insertion position, and Before specifies
+   --  whether the new node is Y's left (True) or right (False) child.
+
+   generic
+      with procedure Insert_Post
+        (T : in out Tree_Type'Class;
+         Y : Count_Type;
+         B : Boolean;
+         Z : out Count_Type);
+
+   procedure Generic_Conditional_Insert
+     (Tree     : in out Tree_Type'Class;
+      Key      : Key_Type;
+      Node     : out Count_Type;
+      Inserted : out Boolean);
+   --  Inserts a new node in Tree, but only if the tree does not already
+   --  contain Key. Generic_Conditional_Insert first searches for a key
+   --  equivalent to Key in Tree. If an equivalent key is found, then on
+   --  output Node designates the node with that key and Inserted is
+   --  False; there is no allocation and Tree is not modified. Otherwise
+   --  Node designates a new node allocated using Insert_Post, and
+   --  Inserted is True.
+
+   generic
+      with procedure Insert_Post
+        (T : in out Tree_Type'Class;
+         Y : Count_Type;
+         B : Boolean;
+         Z : out Count_Type);
+
+   procedure Generic_Unconditional_Insert
+     (Tree : in out Tree_Type'Class;
+      Key  : Key_Type;
+      Node : out Count_Type);
+   --  Inserts a new node in Tree. On output Node designates the new
+   --  node, which is allocated using Insert_Post. The node is inserted
+   --  immediately after already-existing equivalent keys.
+
+   generic
+      with procedure Insert_Post
+        (T : in out Tree_Type'Class;
+         Y : Count_Type;
+         B : Boolean;
+         Z : out Count_Type);
+
+      with procedure Unconditional_Insert_Sans_Hint
+        (Tree    : in out Tree_Type'Class;
+         Key     : Key_Type;
+         Node    : out Count_Type);
+
+   procedure Generic_Unconditional_Insert_With_Hint
+     (Tree : in out Tree_Type'Class;
+      Hint : Count_Type;
+      Key  : Key_Type;
+      Node : out Count_Type);
+   --  Inserts a new node in Tree near position Hint, to avoid having to
+   --  search from the root for the insertion position. If Hint is 0
+   --  then Generic_Unconditional_Insert_With_Hint attempts to insert
+   --  the new node after Tree.Last. If Hint is non-zero then if Key is
+   --  less than Hint, it attempts to insert the new node immediately
+   --  prior to Hint. Otherwise it attempts to insert the node
+   --  immediately following Hint. We say "attempts" above to emphasize
+   --  that insertions always preserve invariants with respect to key
+   --  order, even when there's a hint. So if Key can't be inserted
+   --  immediately near Hint, then the new node is inserted in the
+   --  normal way, by searching for the correct position starting from
+   --  the root.
+
+   generic
+      with procedure Insert_Post
+        (T : in out Tree_Type'Class;
+         Y : Count_Type;
+         B : Boolean;
+         Z : out Count_Type);
+
+      with procedure Conditional_Insert_Sans_Hint
+        (Tree     : in out Tree_Type'Class;
+         Key      : Key_Type;
+         Node     : out Count_Type;
+         Inserted : out Boolean);
+
+   procedure Generic_Conditional_Insert_With_Hint
+     (Tree     : in out Tree_Type'Class;
+      Position : Count_Type;       -- the hint
+      Key      : Key_Type;
+      Node     : out Count_Type;
+      Inserted : out Boolean);
+   --  Inserts a new node in Tree if the tree does not already contain
+   --  Key, using Position as a hint about where to insert the new node.
+   --  See Generic_Unconditional_Insert_With_Hint for more details about
+   --  hint semantics.
+
+   function Find
+     (Tree : Tree_Type'Class;
+      Key  : Key_Type) return Count_Type;
+   --  Searches Tree for the smallest node equivalent to Key
+
+   function Ceiling
+     (Tree : Tree_Type'Class;
+      Key  : Key_Type) return Count_Type;
+   --  Searches Tree for the smallest node equal to or greater than Key
+
+   function Floor
+     (Tree : Tree_Type'Class;
+      Key  : Key_Type) return Count_Type;
+   --  Searches Tree for the largest node less than or equal to Key
+
+   function Upper_Bound
+     (Tree : Tree_Type'Class;
+      Key  : Key_Type) return Count_Type;
+   --  Searches Tree for the smallest node greater than Key
+
+   generic
+      with procedure Process (Index : Count_Type);
+   procedure Generic_Iteration
+     (Tree : Tree_Type'Class;
+      Key  : Key_Type);
+   --  Calls Process for each node in Tree equivalent to Key, in order
+   --  from earliest in range to latest.
+
+   generic
+      with procedure Process (Index : Count_Type);
+   procedure Generic_Reverse_Iteration
+     (Tree : Tree_Type'Class;
+      Key  : Key_Type);
+   --  Calls Process for each node in Tree equivalent to Key, but in
+   --  order from largest in range to earliest.
+
+end Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys;

gcc/ada/a-rbtgbo.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--         ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_BOUNDED_OPERATIONS        --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- 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/>.                                          --
+--                                                                          --
+-- This unit was originally developed by Matthew J Heaney.                  --
+------------------------------------------------------------------------------
+
+--  Tree_Type is used to implement the ordered containers. This package
+--  declares the tree operations that do not depend on keys.
+
+with Ada.Streams; use Ada.Streams;
+
+generic
+   with package Tree_Types is new Generic_Bounded_Tree_Types (<>);
+   use Tree_Types;
+
+   with function  Parent (Node : Node_Type) return Count_Type is <>;
+
+   with procedure Set_Parent
+     (Node   : in out Node_Type;
+      Parent : Count_Type) is <>;
+
+   with function  Left (Node : Node_Type) return Count_Type is <>;
+
+   with procedure Set_Left
+     (Node : in out Node_Type;
+      Left : Count_Type) is <>;
+
+   with function  Right (Node : Node_Type) return Count_Type is <>;
+
+   with procedure Set_Right
+     (Node  : in out Node_Type;
+      Right : Count_Type) is <>;
+
+   with function  Color (Node : Node_Type) return Color_Type is <>;
+
+   with procedure Set_Color
+     (Node  : in out Node_Type;
+      Color : Color_Type) is <>;
+
+package Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations is
+   pragma Pure;
+
+   function Min (Tree : Tree_Type'Class; Node : Count_Type) return Count_Type;
+   --  Returns the smallest-valued node of the subtree rooted at Node
+
+   function Max (Tree : Tree_Type'Class; Node : Count_Type) return Count_Type;
+   --  Returns the largest-valued node of the subtree rooted at Node
+
+   function Vet (Tree : Tree_Type'Class; Index : Count_Type) return Boolean;
+   --  Inspects Node to determine (to the extent possible) whether
+   --  the node is valid; used to detect if the node is dangling.
+
+   function Next
+     (Tree : Tree_Type'Class;
+      Node : Count_Type) return Count_Type;
+   --  Returns the smallest node greater than Node
+
+   function Previous
+     (Tree : Tree_Type'Class;
+      Node : Count_Type) return Count_Type;
+   --  Returns the largest node less than Node
+
+   generic
+      with function Is_Equal (L, R : Node_Type) return Boolean;
+   function Generic_Equal (Left, Right : Tree_Type'Class) return Boolean;
+   --  Uses Is_Equal to perform a node-by-node comparison of the
+   --  Left and Right trees; processing stops as soon as the first
+   --  non-equal node is found.
+
+   procedure Delete_Node_Sans_Free
+     (Tree : in out Tree_Type'Class; Node : Count_Type);
+   --  Removes Node from Tree without deallocating the node. If Tree
+   --  is busy then Program_Error is raised.
+
+   procedure Clear_Tree (Tree : in out Tree_Type'Class);
+   --  Clears Tree by deallocating all of its nodes. If Tree is busy then
+   --  Program_Error is raised.
+
+   generic
+      with procedure Process (Node : Count_Type) is <>;
+   procedure Generic_Iteration (Tree : Tree_Type'Class);
+   --  Calls Process for each node in Tree, in order from smallest-valued
+   --  node to largest-valued node.
+
+   generic
+      with procedure Process (Node : Count_Type) is <>;
+   procedure Generic_Reverse_Iteration (Tree : Tree_Type'Class);
+   --  Calls Process for each node in Tree, in order from largest-valued
+   --  node to smallest-valued node.
+
+   generic
+      with procedure Write_Node
+        (Stream : not null access Root_Stream_Type'Class;
+         Node   : Node_Type);
+   procedure Generic_Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Tree   : Tree_Type'Class);
+   --  Used to implement stream attribute T'Write. Generic_Write
+   --  first writes the number of nodes into Stream, then calls
+   --  Write_Node for each node in Tree.
+
+   generic
+      with procedure Allocate
+        (Tree : in out Tree_Type'Class;
+         Node : out Count_Type);
+   procedure Generic_Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Tree   : in out Tree_Type'Class);
+   --  Used to implement stream attribute T'Read. Generic_Read
+   --  first clears Tree. It then reads the number of nodes out of
+   --  Stream, and calls Read_Node for each node in Stream.
+
+   procedure Rebalance_For_Insert
+     (Tree : in out Tree_Type'Class;
+      Node : Count_Type);
+   --  This rebalances Tree to complete the insertion of Node (which
+   --  must already be linked in at its proper insertion position).
+
+   generic
+      with procedure Set_Element (Node : in out Node_Type);
+   procedure Generic_Allocate
+     (Tree : in out Tree_Type'Class;
+      Node : out Count_Type);
+   --  Claim a node from the free store. Generic_Allocate first
+   --  calls Set_Element on the potential node, and then returns
+   --  the node's index as the value of the Node parameter.
+
+   procedure Free (Tree : in out Tree_Type'Class; X : Count_Type);
+   --  Return a node back to the free store, from where it had
+   --  been previously claimed via Generic_Allocate.
+
+end Ada.Containers.Red_Black_Trees.Generic_Bounded_Operations;

gcc/ada/adaint.c

@@ -1099,11 +1099,7 @@ __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr)
        either case. */
     attr->file_length = statbuf.st_size;  /* all systems */
 
-#ifndef __MINGW32__
-  /* on Windows requires extra system call, see comment in
-     __gnat_file_exists_attr */
   attr->exists = !ret;
-#endif
 
 #if !defined (_WIN32) || defined (RTX)
   /* on Windows requires extra system call, see __gnat_is_readable_file_attr */
@@ -1343,7 +1339,8 @@ win32_filetime (HANDLE h)
 }
 
 /* As above but starting from a FILETIME.  */
-static void f2t (const FILETIME *ft, time_t *t)
+static void
+f2t (const FILETIME *ft, time_t *t)
 {
   union
   {
@@ -1363,18 +1360,14 @@ __gnat_file_time_name_attr (char* name, struct file_attributes* attr)
 {
    if (attr->timestamp == (OS_Time)-2) {
 #if defined (_WIN32) && !defined (RTX)
+      BOOL res;
+      WIN32_FILE_ATTRIBUTE_DATA fad;
       time_t ret = -1;
       TCHAR wname[GNAT_MAX_PATH_LEN];
       S2WSC (wname, name, GNAT_MAX_PATH_LEN);
 
-      HANDLE h = CreateFile
-        (wname, GENERIC_READ, FILE_SHARE_READ, 0,
-         OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
-
-      if (h != INVALID_HANDLE_VALUE) {
-         ret = win32_filetime (h);
-         CloseHandle (h);
-      }
+      if (res = GetFileAttributesEx (wname, GetFileExInfoStandard, &fad))
+	f2t (&fad.ftLastWriteTime, &ret);
       attr->timestamp = (OS_Time) ret;
 #else
       __gnat_stat_to_attr (-1, name, attr);
@@ -1713,17 +1706,17 @@ __gnat_stat (char *name, GNAT_STRUCT_STAT *statbuf)
 
   if (res == FALSE)
     switch (GetLastError()) {
-    case ERROR_ACCESS_DENIED:
-    case ERROR_SHARING_VIOLATION:
-    case ERROR_LOCK_VIOLATION:
-    case ERROR_SHARING_BUFFER_EXCEEDED:
-      return EACCES;
-    case ERROR_BUFFER_OVERFLOW:
-      return ENAMETOOLONG;
-    case ERROR_NOT_ENOUGH_MEMORY:
-      return ENOMEM;
-    default:
-      return ENOENT;
+      case ERROR_ACCESS_DENIED:
+      case ERROR_SHARING_VIOLATION:
+      case ERROR_LOCK_VIOLATION:
+      case ERROR_SHARING_BUFFER_EXCEEDED:
+	return EACCES;
+      case ERROR_BUFFER_OVERFLOW:
+	return ENAMETOOLONG;
+      case ERROR_NOT_ENOUGH_MEMORY:
+	return ENOMEM;
+      default:
+	return ENOENT;
     }
 
   f2t (&fad.ftCreationTime, &statbuf->st_ctime);
@@ -1758,16 +1751,7 @@ int
 __gnat_file_exists_attr (char* name, struct file_attributes* attr)
 {
    if (attr->exists == ATTR_UNSET) {
-#ifdef __MINGW32__
-      /*  On Windows do not use __gnat_stat() because of a bug in Microsoft
-         _stat() routine. When the system time-zone is set with a negative
-         offset the _stat() routine fails on specific files like CON:  */
-      TCHAR wname [GNAT_MAX_PATH_LEN + 2];
-      S2WSC (wname, name, GNAT_MAX_PATH_LEN + 2);
-      attr->exists = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
-#else
       __gnat_stat_to_attr (-1, name, attr);
-#endif
    }
 
    return attr->exists;

gcc/ada/impunit.adb

@@ -507,7 +507,9 @@ package body Impunit is
    Non_Imp_File_Names_12 : constant File_List := (
      "s-multip",    -- System.Multiprocessors
      "s-mudido",    -- System.Multiprocessors.Dispatching_Domains
-     "a-cobove");   -- Ada.Containers.Bounded_Vectors
+     "a-cobove",    -- Ada.Containers.Bounded_Vectors
+     "a-cborse",    -- Ada.Containers.Bounded_Ordered_Sets
+     "a-cborma");   -- Ada.Containers.Bounded_Ordered_Maps
 
    -----------------------
    -- Alternative Units --

gcc/ada/sem_ch12.adb

@@ -3314,12 +3314,13 @@ package body Sem_Ch12 is
             end if;
          end;
 
-         --  If we are generating the calling stubs from the instantiation of
-         --  a generic RCI package, we will not use the body of the generic
-         --  package.
+         --  If we are generating calling stubs, we never need a body for an
+         --  instantiation from source. However normal processing occurs for
+         --  any generic instantiation appearing in generated code, since we
+         --  do not generate stubs in that case.
 
          if Distribution_Stub_Mode = Generate_Caller_Stub_Body
-           and then Is_Compilation_Unit (Defining_Entity (N))
+              and then Comes_From_Source (N)
          then
             Needs_Body := False;
          end if;
@@ -4000,6 +4001,9 @@ package body Sem_Ch12 is
          Check_Formal_Packages (Pack_Id);
          Set_Is_Generic_Instance (Pack_Id, False);
 
+         --  Why do we clear Is_Generic_Instance??? We set it 20 lines
+         --  above???
+
          --  Body of the enclosing package is supplied when instantiating the
          --  subprogram body, after semantic analysis is completed.
 

gcc/ada/sem_ch3.adb

@@ -12949,9 +12949,18 @@ package body Sem_Ch3 is
                   Collect_Primitive_Operations (Parent_Type);
 
       function Check_Derived_Type return Boolean;
-      --  Check that all primitive inherited from Parent_Type are found in
+      --  Check that all the entities derived from Parent_Type are found in
       --  the list of primitives of Derived_Type exactly in the same order.
 
+      procedure Derive_Interface_Subprogram
+        (New_Subp    : in out Entity_Id;
+         Subp        : Entity_Id;
+         Actual_Subp : Entity_Id);
+      --  Derive New_Subp from the ultimate alias of the parent subprogram Subp
+      --  (which is an interface primitive). If Generic_Actual is present then
+      --  Actual_Subp is the actual subprogram corresponding with the generic
+      --  subprogram Subp.
+
       function Check_Derived_Type return Boolean is
          E        : Entity_Id;
          Elmt     : Elmt_Id;
@@ -13027,6 +13036,45 @@ package body Sem_Ch3 is
          return True;
       end Check_Derived_Type;
 
+      ---------------------------------
+      -- Derive_Interface_Subprogram --
+      ---------------------------------
+
+      procedure Derive_Interface_Subprogram
+        (New_Subp    : in out Entity_Id;
+         Subp        : Entity_Id;
+         Actual_Subp : Entity_Id)
+      is
+         Iface_Subp : constant Entity_Id := Ultimate_Alias (Subp);
+         Iface_Type : constant Entity_Id := Find_Dispatching_Type (Iface_Subp);
+
+      begin
+         pragma Assert (Is_Interface (Iface_Type));
+
+         Derive_Subprogram
+           (New_Subp     => New_Subp,
+            Parent_Subp  => Iface_Subp,
+            Derived_Type => Derived_Type,
+            Parent_Type  => Iface_Type,
+            Actual_Subp  => Actual_Subp);
+
+         --  Given that this new interface entity corresponds with a primitive
+         --  of the parent that was not overridden we must leave it associated
+         --  with its parent primitive to ensure that it will share the same
+         --  dispatch table slot when overridden.
+
+         if No (Actual_Subp) then
+            Set_Alias (New_Subp, Subp);
+
+         --  For instantiations this is not needed since the previous call to
+         --  Derive_Subprogram leaves the entity well decorated.
+
+         else
+            pragma Assert (Alias (New_Subp) = Actual_Subp);
+            null;
+         end if;
+      end Derive_Interface_Subprogram;
+
       --  Local variables
 
       Alias_Subp   : Entity_Id;
@@ -13179,7 +13227,7 @@ package body Sem_Ch3 is
             Alias_Subp := Ultimate_Alias (Subp);
 
             --  Do not derive internal entities of the parent that link
-            --  interface primitives and its covering primitive. These
+            --  interface primitives with their covering primitive. These
             --  entities will be added to this type when frozen.
 
             if Present (Interface_Alias (Subp)) then
@@ -13334,15 +13382,74 @@ package body Sem_Ch3 is
                 (Nkind (Parent (Alias_Subp)) = N_Procedure_Specification
                   and then Null_Present (Parent (Alias_Subp)))
             then
-               Derive_Subprogram
-                 (New_Subp     => New_Subp,
-                  Parent_Subp  => Alias_Subp,
-                  Derived_Type => Derived_Type,
-                  Parent_Type  => Find_Dispatching_Type (Alias_Subp),
-                  Actual_Subp  => Act_Subp);
+               --  If this is an abstract private type then we transfer the
+               --  derivation of the interface primitive from the partial view
+               --  to the full view. This is safe because all the interfaces
+               --  must be visible in the partial view. Done to avoid adding
+               --  a new interface derivation to the private part of the
+               --  enclosing package; otherwise this new derivation would be
+               --  decorated as hidden when the analysis of the enclosing
+               --  package completes.
+
+               if Is_Abstract_Type (Derived_Type)
+                 and then In_Private_Part (Current_Scope)
+                 and then Has_Private_Declaration (Derived_Type)
+               then
+                  declare
+                     Partial_View : Entity_Id;
+                     Elmt         : Elmt_Id;
+                     Ent          : Entity_Id;
+
+                  begin
+                     Partial_View := First_Entity (Current_Scope);
+                     loop
+                        exit when No (Partial_View)
+                          or else (Has_Private_Declaration (Partial_View)
+                                     and then
+                                   Full_View (Partial_View) = Derived_Type);
+
+                        Next_Entity (Partial_View);
+                     end loop;
+
+                     --  If the partial view was not found then the source code
+                     --  has errors and the derivation is not needed.
 
-               if No (Generic_Actual) then
-                  Set_Alias (New_Subp, Subp);
+                     if Present (Partial_View) then
+                        Elmt :=
+                          First_Elmt (Primitive_Operations (Partial_View));
+                        while Present (Elmt) loop
+                           Ent := Node (Elmt);
+
+                           if Present (Alias (Ent))
+                             and then Ultimate_Alias (Ent) = Alias (Subp)
+                           then
+                              Append_Elmt
+                                (Ent, Primitive_Operations (Derived_Type));
+                              exit;
+                           end if;
+
+                           Next_Elmt (Elmt);
+                        end loop;
+
+                        --  If the interface primitive was not found in the
+                        --  partial view then this interface primitive was
+                        --  overridden. We add a derivation to activate in
+                        --  Derive_Progenitor_Subprograms the machinery to
+                        --  search for it.
+
+                        if No (Elmt) then
+                           Derive_Interface_Subprogram
+                             (New_Subp    => New_Subp,
+                              Subp        => Subp,
+                              Actual_Subp => Act_Subp);
+                        end if;
+                     end if;
+                  end;
+               else
+                  Derive_Interface_Subprogram
+                    (New_Subp     => New_Subp,
+                     Subp         => Subp,
+                     Actual_Subp  => Act_Subp);
                end if;
 
             --  Case 3: Common derivation

gcc/ada/sem_util.adb

@@ -3045,9 +3045,9 @@ package body Sem_Util is
             Set_Scope (Def_Id, Current_Scope);
             return;
 
-         --  Analogous to privals, the discriminal generated for an entry
-         --  index parameter acts as a weak declaration. Perform minimal
-         --  decoration to avoid bogus errors.
+         --  Analogous to privals, the discriminal generated for an entry index
+         --  parameter acts as a weak declaration. Perform minimal decoration
+         --  to avoid bogus errors.
 
          elsif Is_Discriminal (Def_Id)
            and then Ekind (Discriminal_Link (Def_Id)) = E_Entry_Index_Parameter
@@ -3055,11 +3055,10 @@ package body Sem_Util is
             Set_Scope (Def_Id, Current_Scope);
             return;
 
-         --  In the body or private part of an instance, a type extension
-         --  may introduce a component with the same name as that of an
-         --  actual. The legality rule is not enforced, but the semantics
-         --  of the full type with two components of the same name are not
-         --  clear at this point ???
+         --  In the body or private part of an instance, a type extension may
+         --  introduce a component with the same name as that of an actual. The
+         --  legality rule is not enforced, but the semantics of the full type
+         --  with two components of same name are not clear at this point???
 
          elsif In_Instance_Not_Visible then
             null;
@@ -3073,9 +3072,9 @@ package body Sem_Util is
          then
             null;
 
-         --  Conversely, with front-end inlining we may compile the parent
-         --  body first, and a child unit subsequently. The context is now
-         --  the parent spec, and body entities are not visible.
+         --  Conversely, with front-end inlining we may compile the parent body
+         --  first, and a child unit subsequently. The context is now the
+         --  parent spec, and body entities are not visible.
 
          elsif Is_Child_Unit (Def_Id)
            and then Is_Package_Body_Entity (E)
@@ -3089,8 +3088,8 @@ package body Sem_Util is
             Error_Msg_Sloc := Sloc (E);
 
             --  If the previous declaration is an incomplete type declaration
-            --  this may be an attempt to complete it with a private type.
-            --  The following avoids confusing cascaded errors.
+            --  this may be an attempt to complete it with a private type. The
+            --  following avoids confusing cascaded errors.
 
             if Nkind (Parent (E)) = N_Incomplete_Type_Declaration
               and then Nkind (Parent (Def_Id)) = N_Private_Type_Declaration
@@ -3113,9 +3112,9 @@ package body Sem_Util is
                Error_Msg_N ("& conflicts with declaration#", E);
                return;
 
-            --  If the name of the unit appears in its own context clause,
-            --  a dummy package with the name has already been created, and
-            --  the error emitted. Try to continue quietly.
+            --  If the name of the unit appears in its own context clause, a
+            --  dummy package with the name has already been created, and the
+            --  error emitted. Try to continue quietly.
 
             elsif Error_Posted (E)
               and then Sloc (E) = No_Location
@@ -3144,9 +3143,9 @@ package body Sem_Util is
                Error_Msg_N ("\generic units cannot be overloaded", Def_Id);
             end if;
 
-            --  If entity is in standard, then we are in trouble, because
-            --  it means that we have a library package with a duplicated
-            --  name. That's hard to recover from, so abort!
+            --  If entity is in standard, then we are in trouble, because it
+            --  means that we have a library package with a duplicated name.
+            --  That's hard to recover from, so abort!
 
             if S = Standard_Standard then
                raise Unrecoverable_Error;
@@ -3160,17 +3159,17 @@ package body Sem_Util is
          end if;
       end if;
 
-      --  If we fall through, declaration is OK , or OK enough to continue
+      --  If we fall through, declaration is OK, at least OK enough to continue
 
-      --  If Def_Id is a discriminant or a record component we are in the
-      --  midst of inheriting components in a derived record definition.
-      --  Preserve their Ekind and Etype.
+      --  If Def_Id is a discriminant or a record component we are in the midst
+      --  of inheriting components in a derived record definition. Preserve
+      --  their Ekind and Etype.
 
       if Ekind_In (Def_Id, E_Discriminant, E_Component) then
          null;
 
-      --  If a type is already set, leave it alone (happens whey a type
-      --  declaration is reanalyzed following a call to the optimizer)
+      --  If a type is already set, leave it alone (happens when a type
+      --  declaration is reanalyzed following a call to the optimizer).
 
       elsif Present (Etype (Def_Id)) then
          null;
@@ -3227,8 +3226,8 @@ package body Sem_Util is
 
          and then In_Extended_Main_Source_Unit (Def_Id)
 
-         --  Finally, the hidden entity must be either immediately visible
-         --  or use visible (from a used package)
+         --  Finally, the hidden entity must be either immediately visible or
+         --  use visible (i.e. from a used package).
 
          and then
            (Is_Immediately_Visible (C)

gcc/ada/usage.adb

@@ -425,8 +425,8 @@ begin
    Write_Line ("        F*   turn off warnings for unreferenced formal");
    Write_Line ("        g*+  turn on warnings for unrecognized pragma");
    Write_Line ("        G    turn off warnings for unrecognized pragma");
-   Write_Line ("        h    turn on warnings for hiding variable");
-   Write_Line ("        H*   turn off warnings for hiding variable");
+   Write_Line ("        h    turn on warnings for hiding declarations");
+   Write_Line ("        H*   turn off warnings for hiding declarations");
    Write_Line ("        .h   turn on warnings for holes in records");
    Write_Line ("        .H*  turn off warnings for holes in records");
    Write_Line ("        i*+  turn on warnings for implementation unit");