https://gcc.gnu.org/g:a358cc570873299e9e396849f3c28028a6270c5b

commit r16-6621-ga358cc570873299e9e396849f3c28028a6270c5b
Author: Steve Baird <[email protected]>
Date:   Wed Nov 5 14:13:16 2025 -0800

    ada: Implement Ada.Containers.Bounded_Indefinite_Holders.
    
    Implement the predefined unit Ada.Containers.Bounded_Indefinite_Holders.
    
    gcc/ada/ChangeLog:
    
            * Makefile.rtl: add entry for new unit
            * impunit.adb: add entry for new unit
            * libgnat/a-cbinho.adb: new file with body for new unit
            * libgnat/a-cbinho.ads: new file with spec for new unit
            * libgnat/a-coboho.ads: add comment
            * libgnat/a-undesu.ads: add Preelaborate aspect specification,
            as per AI22-0050.

Diff:
---
 gcc/ada/Makefile.rtl         |   1 +
 gcc/ada/impunit.adb          |   1 +
 gcc/ada/libgnat/a-cbinho.adb | 413 +++++++++++++++++++++++++++++++++++++++++++
 gcc/ada/libgnat/a-cbinho.ads | 316 +++++++++++++++++++++++++++++++++
 gcc/ada/libgnat/a-coboho.ads |   4 +
 gcc/ada/libgnat/a-undesu.ads |   3 +-
 6 files changed, 737 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 2c3891dc4645..cd777237cfe1 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -110,6 +110,7 @@ GNATRTL_NONTASKING_OBJS= \
   a-cbdlli$(objext) \
   a-cbhama$(objext) \
   a-cbhase$(objext) \
+  a-cbinho$(objext) \
   a-cbmutr$(objext) \
   a-cborma$(objext) \
   a-cborse$(objext) \
diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb
index b73c65e0c2a8..003a765e48c3 100644
--- a/gcc/ada/impunit.adb
+++ b/gcc/ada/impunit.adb
@@ -584,6 +584,7 @@ package body Impunit is
     ("a-cborma", T),  -- Ada.Containers.Bounded_Ordered_Maps
     ("a-cbhase", T),  -- Ada.Containers.Bounded_Hashed_Sets
     ("a-cbhama", T),  -- Ada.Containers.Bounded_Hashed_Maps
+    ("a-cbinho", T),  -- Ada.Containers.Bounded_Indefinite_Holders
     ("a-coinho", T),  -- Ada.Containers.Indefinite_Holders
     ("a-comutr", T),  -- Ada.Containers.Multiway_Trees
     ("a-cimutr", T),  -- Ada.Containers.Indefinite_Multiway_Trees
diff --git a/gcc/ada/libgnat/a-cbinho.adb b/gcc/ada/libgnat/a-cbinho.adb
new file mode 100644
index 000000000000..94f479b487fe
--- /dev/null
+++ b/gcc/ada/libgnat/a-cbinho.adb
@@ -0,0 +1,413 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--                ADA.CONTAINERS.BOUNDED_INDEFINITE_HOLDERS                 --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 2011-2025, 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/>.                                          --
+------------------------------------------------------------------------------
+
+with Ada.Unchecked_Deallocate_Subpool;
+with Ada.Unchecked_Deallocation;
+with System.Put_Images;
+
+package body Ada.Containers.Bounded_Indefinite_Holders is
+
+   use type System.Address;
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Element_Type, Element_Access);
+
+   function "=" (Left, Right : Holder) return Boolean is
+     (if Left.Element = null or Right.Element = null
+       then Left.Element = Right.Element
+       else Left.Element.all = Right.Element.all);
+
+   ------------
+   -- Adjust --
+   ------------
+
+   overriding procedure Adjust (Container : in out Holder) is
+   begin
+      Container.Handle := Create_Subpool (The_Storage_Pool, Container);
+      Container.Element :=
+        new (Container.Handle) Element_Type'(Container.Element.all);
+   end Adjust;
+
+   ------------
+   -- Assign --
+   ------------
+
+   procedure Assign (Target : in out Holder; Source : Holder) is
+   begin
+      if Target'Address /= Source'Address then
+         if Is_Empty (Source) then
+            Clear (Target);
+         else
+            Replace_Element (Target, Source.Element.all);
+         end if;
+      end if;
+   end Assign;
+
+   -----------
+   -- Clear --
+   -----------
+
+   procedure Clear (Container : in out Holder) is
+   begin
+      if Is_Empty (Container) then
+         return; -- nothing to do
+      end if;
+      if Container.Busy /= 0 then
+         raise Program_Error with "attempt to tamper with elements";
+      end if;
+      Free (Container.Element); -- finalize element
+      Ada.Unchecked_Deallocate_Subpool (Container.Handle);
+   end Clear;
+
+   ------------------------
+   -- Constant_Reference --
+   ------------------------
+
+   function Constant_Reference
+     (Container : aliased Holder) return Constant_Reference_Type
+   is
+      Ref : constant Constant_Reference_Type :=
+        (Element => Container.Element,
+         Control => (Controlled with Container'Unrestricted_Access));
+      B : Natural renames Ref.Control.Container.Busy;
+   begin
+      B := B + 1;
+      return Ref;
+   end Constant_Reference;
+
+   ----------
+   -- Copy --
+   ----------
+
+   function Copy (Source : Holder) return Holder is
+      (if Is_Empty (Source)
+       then Empty_Holder
+       else To_Holder (Source.Element.all));
+
+   -------------
+   -- Element --
+   -------------
+
+   function Element (Container : Holder) return Element_Type is
+     (Container.Element.all);
+
+   --------------
+   -- Finalize --
+   --------------
+
+   overriding procedure Finalize (Container : in out Holder) is
+   begin
+      Clear (Container);
+   end Finalize;
+
+   --  NOTE: No procedure Initialize because requires preelaborable init.
+   overriding procedure Finalize (Control : in out Reference_Control_Type) is
+   begin
+      if Control.Container /= null then
+         declare
+            B : Natural renames Control.Container.Busy;
+         begin
+            B := B - 1;
+         end;
+      end if;
+
+      Control.Container := null;
+   end Finalize;
+
+   --------------
+   -- Is_Empty --
+   --------------
+
+   function Is_Empty (Container : Holder) return Boolean
+     is (Container.Element = null);
+
+   ----------
+   -- Move --
+   ----------
+
+   procedure Move (Target : in out Holder; Source : in out Holder) is
+   begin
+      if Target'Address /= Source'Address then
+         Assign (Target => Target, Source => Source);
+         Clear (Source);
+      end if;
+   end Move;
+
+   ---------------
+   -- Put_Image --
+   ---------------
+
+   procedure Put_Image
+     (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Holder)
+   is
+      use System.Put_Images;
+   begin
+      Array_Before (S);
+      if not Is_Empty (V) then
+         Element_Type'Put_Image (S, Element (V));
+      end if;
+      Array_After (S);
+   end Put_Image;
+
+   -------------------
+   -- Query_Element --
+   -------------------
+
+   procedure Query_Element
+     (Container : Holder;
+      Process   : not null access procedure (Element : Element_Type)) is
+   begin
+      Process.all (Container.Element.all);
+   end Query_Element;
+
+   ----------
+   -- Read --
+   ----------
+
+   procedure Read
+     (Stream    : not null access Root_Stream_Type'Class;
+      Container : out Holder)
+   is
+   begin
+      if Boolean'Input (Stream) then
+         Clear (Container);
+      else
+         Replace_Element (Container, Element_Type'Input (Stream));
+      end if;
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Reference
+     (Container : aliased in out Holder) return Reference_Type
+   is
+      Ref : constant Reference_Type :=
+              (Element => Container.Element,
+               Control => (Controlled with Container'Unrestricted_Access));
+   begin
+      Container.Busy := Container.Busy + 1;
+      return Ref;
+   end Reference;
+
+   ---------------------
+   -- Replace_Element --
+   ---------------------
+
+   procedure Replace_Element
+     (Container : in out Holder; New_Item : Element_Type)
+   is
+   begin
+      if (New_Item'Size / System.Storage_Unit) +
+        Boolean'Pos (New_Item'Size mod System.Storage_Unit /= 0) >
+        Max_Element_Size_In_Storage_Elements
+      then
+         --  New_Item is too big; detect this early, before calling Clear
+         --  (as opposed to catching it later in Allocate_From_Subpool).
+         raise Program_Error;
+      end if;
+      Clear (Container);
+      if Container.Handle = null then
+         Container.Handle := Create_Subpool (The_Storage_Pool, Container);
+      end if;
+      Container.Element := new (Container.Handle) Element_Type'(New_Item);
+   end Replace_Element;
+
+   ---------------------
+   -- Subpool_Support --
+   ---------------------
+
+   package body Subpool_Support is
+      function Create_Subpool (Pool : in out Holder_Pool_Type)
+        return not null Subpool_Handle is
+      begin
+         return (raise Program_Error);
+      end Create_Subpool;
+
+      function Aligned_Address
+        (Addr : System.Address; Alignment : Storage_Count)
+        return System.Address;
+      --  Return Addr, rounded up to multiple of Alignment
+
+      function Aligned_Address
+        (Addr : System.Address; Alignment : Storage_Count)
+        return System.Address
+      is
+         Initial_Align : constant Storage_Count := Addr mod Alignment;
+      begin
+         if Initial_Align = 0 then
+            --  Already aligned
+            return Addr;
+         else
+            --  Adjust to get into alignment
+            return Addr + (Alignment - Initial_Align);
+         end if;
+      end Aligned_Address;
+
+      function Create_Subpool
+        (Pool : in out Holder_Pool_Type'Class; Container : Holder)
+        return not null Subpool_Handle
+      is
+         --  Compute start addresses for subpool and element within Storage
+         Subpool_Start : constant System.Address :=
+           Aligned_Address
+             (Container.Wrapper.Storage'Address, Holder_Subpool'Alignment);
+
+         Element_Start : constant System.Address :=
+           Subpool_Start + Holder_Subpool'Max_Size_In_Storage_Elements;
+            --  Will deal with alignment on allocation
+
+         Subpool : aliased Holder_Subpool :=
+           (Root_Subpool with Start => Element_Start)
+           with Address => Subpool_Start;
+          --  We depend here on the type Holder_Subpool not having nontrivial
+          --  finalization (if it did then this local object would be
+          --  finalized earlier than what we want).
+      begin
+         Set_Pool_Of_Subpool (Subpool'Unchecked_Access, Pool);
+         --  Return the handle
+         return Subpool'Unchecked_Access;
+      end Create_Subpool;
+
+      procedure Allocate_From_Subpool
+        (Pool : in out Holder_Pool_Type;
+         Storage_Address : out System.Address;
+         Size_In_Storage_Elements : Storage_Count;
+         Alignment : Storage_Count;
+         Subpool : not null Subpool_Handle) is
+      begin
+         if Size_In_Storage_Elements + Alignment >
+            Max_Element_Size_In_Storage_Elements + Element_Type'Alignment
+         then
+            --  If we pass the size check in Replace_Element (which we had to
+            --  in order to get here) and then fail this check, then that is
+            --  a bug (although arguably a corner case).
+            --  If we get here, that probably means that the result returned
+            --  by Max_Allocation_Overhead_In_Storage_Elements was too small
+            --  (with the result that Bound_Range'Last is too small).
+            raise Program_Error;
+         end if;
+         Storage_Address :=
+           Aligned_Address (Holder_Subpool (Subpool.all).Start, Alignment);
+      end Allocate_From_Subpool;
+
+      procedure Deallocate_Subpool
+        (Pool : in out Holder_Pool_Type;
+         Subpool : in out Subpool_Handle) is
+      begin
+         --  Nothing to do
+         null;
+      end Deallocate_Subpool;
+
+   end Subpool_Support;
+
+   ----------
+   -- Swap --
+   ----------
+
+   procedure Swap (Left, Right : in out Holder) is
+      Temp : Holder;
+   begin
+      Assign (Target => Temp, Source => Left);
+      Move (Target => Left, Source => Right);
+      Move (Target => Right, Source => Temp);
+   end Swap;
+
+   ---------------
+   -- To_Holder --
+   ---------------
+
+   function To_Holder (New_Item : Element_Type) return Holder is
+   begin
+      return Result : Holder do
+         Replace_Element (Result, New_Item);
+      end return;
+   end To_Holder;
+
+   --------------------
+   -- Update_Element --
+   --------------------
+
+   procedure Update_Element
+     (Container : in out Holder;
+      Process   : not null access procedure (Element : in out Element_Type)) is
+   begin
+      Process.all (Container.Element.all);
+   end Update_Element;
+
+   -----------
+   -- Write --
+   -----------
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream    : not null access Root_Stream_Type'Class;
+      Container : Holder)
+   is
+   begin
+      --  Polarity of this Boolean determined by streaming-related
+      --  implementation requirements of RM A.18.32.
+
+      Boolean'Write (Stream, Container.Element = null);
+      if Container.Element /= null then
+         Element_Type'Write (Stream, Container.Element.all);
+      end if;
+   end Write;
+
+end Ada.Containers.Bounded_Indefinite_Holders;
diff --git a/gcc/ada/libgnat/a-cbinho.ads b/gcc/ada/libgnat/a-cbinho.ads
new file mode 100644
index 000000000000..0aaacd356aa0
--- /dev/null
+++ b/gcc/ada/libgnat/a-cbinho.ads
@@ -0,0 +1,316 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--                ADA.CONTAINERS.BOUNDED_INDEFINITE_HOLDERS                 --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--          Copyright (C) 2011-2025, 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/>.                                          --
+------------------------------------------------------------------------------
+
+with System.Storage_Elements; use System.Storage_Elements;
+
+private with Ada.Finalization;
+private with Ada.Streams;
+private with Ada.Strings.Text_Buffers;
+private with System.Storage_Pools.Subpools;
+
+generic
+   type Element_Type (<>) is private;
+   Max_Element_Size_In_Storage_Elements : Storage_Count;
+   with function "=" (Left, Right : Element_Type) return Boolean is <>;
+
+package Ada.Containers.Bounded_Indefinite_Holders is
+   pragma Annotate (CodePeer, Skip_Analysis);
+   pragma Preelaborate (Bounded_Indefinite_Holders);
+   pragma Remote_Types (Bounded_Indefinite_Holders);
+
+   type Holder is tagged private
+   with
+     Preelaborable_Initialization => Element_Type'Preelaborable_Initialization;
+
+   Empty_Holder : constant Holder;
+
+   function "=" (Left, Right : Holder) return Boolean;
+
+   function To_Holder (New_Item : Element_Type) return Holder;
+
+   function Is_Empty (Container : Holder) return Boolean;
+
+   procedure Clear (Container : in out Holder);
+
+   function Element (Container : Holder) return Element_Type;
+
+   procedure Replace_Element
+     (Container : in out Holder;
+      New_Item  : Element_Type);
+
+   procedure Query_Element
+     (Container : Holder;
+      Process   : not null access procedure (Element : Element_Type));
+
+   procedure Update_Element
+     (Container : in out Holder;
+      Process   : not null access procedure (Element : in out Element_Type));
+
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is limited private
+   with
+      Implicit_Dereference => Element;
+
+   type Reference_Type
+     (Element : not null access Element_Type) is limited private
+   with
+      Implicit_Dereference => Element;
+
+   function Constant_Reference
+     (Container : aliased Holder) return Constant_Reference_Type;
+   pragma Inline (Constant_Reference);
+
+   function Reference
+     (Container : aliased in out Holder) return Reference_Type;
+   pragma Inline (Reference);
+
+   procedure Assign (Target : in out Holder; Source : Holder);
+
+   function Copy (Source : Holder) return Holder;
+
+   procedure Move (Target : in out Holder; Source : in out Holder);
+
+   procedure Swap (Left, Right : in out Holder);
+
+private
+
+   use Ada.Finalization;
+   use Ada.Streams;
+   use System.Storage_Pools.Subpools;
+
+   procedure Read
+     (Stream    : not null access Root_Stream_Type'Class;
+      Container : out Holder);
+
+   procedure Write
+     (Stream    : not null access Root_Stream_Type'Class;
+      Container : Holder);
+
+   procedure Put_Image
+     (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Holder);
+
+   package Subpool_Support is
+
+      type Holder_Pool_Type is
+        limited new Root_Storage_Pool_With_Subpools with null record;
+
+      type Holder_Subpool is
+        limited new Root_Subpool with record
+         Start : System.Address := System.Null_Address;
+      end record;
+
+      overriding
+      function Create_Subpool (Pool : in out Holder_Pool_Type)
+        return not null Subpool_Handle
+        ; --  tbd with No_Return;
+      --  We never use this one.  It will raise Program_Error
+
+      overriding
+      procedure Allocate_From_Subpool
+        (Pool : in out Holder_Pool_Type;
+         Storage_Address : out System.Address;
+         Size_In_Storage_Elements : Storage_Count;
+         Alignment : Storage_Count;
+         Subpool : not null Subpool_Handle);
+
+      overriding
+      procedure Deallocate_Subpool
+        (Pool : in out Holder_Pool_Type;
+         Subpool : in out Subpool_Handle);
+
+      function Create_Subpool
+        (Pool : in out Holder_Pool_Type'Class; Container : Holder)
+        return not null Subpool_Handle;
+
+      The_Storage_Pool : Holder_Pool_Type;
+      --  The one and only object of this type ever created.
+   end Subpool_Support;
+
+   use Subpool_Support;
+
+   type Element_Access is access Element_Type
+     with Storage_Pool => Subpool_Support.The_Storage_Pool,
+          Size => Standard'Address_Size;
+   --  Size specification needed to ensure contiguous bounds if Element_Type
+   --  turns out to be an unconstrained array subtype. We do not want a
+   --  fat-pointer representation in that case.
+
+   pragma No_Strict_Aliasing (Element_Access);
+   --  Needed because we are unchecked-converting from Address to
+   --  Element_Access (see package body), which is a violation of the
+   --  normal aliasing rules enforced by gcc.
+
+   Worst_Case_Alignment : constant Storage_Count :=
+     Storage_Count'Max (Holder_Subpool'Alignment,
+       Storage_Count'Max (System.Address'Alignment,
+         Element_Type'Alignment));
+
+   --  Convert Element_Type'Size from bits to bytes, rounding up
+   Element_Size_In_Storage_Elements : constant Long_Integer :=
+     Long_Integer ((Element_Type'Size / System.Storage_Unit) +
+       Boolean'Pos (Element_Type'Size mod System.Storage_Unit /= 0));
+
+   --  An upper bound on additional storage required for an allocator for data
+   --  other than the allocated object itself. This includes things like
+   --  array bounds (if Element_Type is an unconstrained array subtype),
+   --  finalization-related linkage (if Element_Type requires
+   --  finalization), alignment-related gaps between such prefix info and the
+   --  allocated object, etc. This does not include alignment-related
+   --  overhead except for aforementioned possibility of an alignment-related
+   --  gap between some prefix data and the object itself.
+
+   function Max_Allocation_Overhead_In_Storage_Elements return Storage_Count is
+     (if Element_Size_In_Storage_Elements >= Long_Integer (Integer'Last) then
+         --  If the more precise computation in the else-arm (below) could
+         --  overflow or return the wrong answer then return a guess.
+         --  We get a multiplier of 6 by adding 2 for finalization-linkage
+         --  and 4 for array bounds. If we have an unconstrained array subtype
+         --  with a controlled element type and with multiple dimensions each
+         --  indexed by Long_Long_Integer, then this guess could be too small.
+         System.Address'Max_Size_In_Storage_Elements * 6
+      else
+         Storage_Count (Element_Type'Max_Size_In_Storage_Elements -
+           Element_Size_In_Storage_Elements));
+   --
+   --  ???  It would be helpful if GNAT provided this value as an attribute so
+   --  that we would not have to deal with the "huge" case here. Instead, we
+   --  use a very imprecise "hugeness" test; in the "huge" case, we return an
+   --  estimate. If the estimate turns out to be too small, then it is
+   --  possible for the size check in Allocate_From_Subpool to fail even
+   --  though the earlier (earlier at run-time) size check in Replace_Element
+   --  passed. A GNAT-defined attribute could eliminate this issue.
+
+   --  Compute extra amount needed for space requested for an allocator
+   --  (specifically, in a call to Allocate_From_Subpool) in addition to
+   --  the space required for the allocated object itself.
+   Extra_Storage : constant Storage_Count :=
+     Holder_Subpool'Max_Size_In_Storage_Elements +
+     Worst_Case_Alignment * 2 +
+     Max_Allocation_Overhead_In_Storage_Elements;
+
+   subtype Bound_Range is Storage_Count range
+     0 ..  Max_Element_Size_In_Storage_Elements + Extra_Storage;
+
+   type Storage_Wrapper (Bound : Bound_Range := 0) is record
+      Storage : aliased Storage_Array (1 .. Bound);
+         --  Should allocate space for case when Bound = Bound_Range'Last
+         --  but we actually leave Bound at zero so assignment
+         --  is faster (this wouldn't work if the compiler didn't
+         --  allocate the "max" for types with defaulted discriminants).
+   end record;
+
+   type Holder is new Ada.Finalization.Controlled with record
+      Busy : Natural := 0;
+      Handle : Subpool_Handle;
+      Element : Element_Access;
+      Wrapper : Storage_Wrapper;
+   end record
+     with Put_Image => Put_Image, Read => Read, Write => Write;
+
+   overriding procedure Adjust (Container : in out Holder);
+   overriding procedure Finalize (Container : in out Holder);
+
+   type Holder_Access is access all Holder;
+   for Holder_Access'Storage_Size use 0;
+
+   --  Instead of declaring Reference_Control_Type as a controlled type,
+   --  we could use the GNAT-defined Finalizable aspect instead.
+   --  But we would not want to make this change only in this unit - many
+   --  of the container generics declare a Reference_Control_Type type.
+   --  In particular, we want to minimize differences between this unit
+   --  and the corresponding unbounded unit (Ada.Indefinite_Holders).
+
+   type Reference_Control_Type is new Controlled with record
+      Container : Holder_Access;
+   end record;
+
+   overriding procedure Finalize (Control : in out Reference_Control_Type);
+   pragma Inline (Finalize);
+
+   type Constant_Reference_Type
+     (Element : not null access constant Element_Type) is
+   record
+      Control : Reference_Control_Type :=
+        (raise Program_Error with "default initialized reference");
+      --  The RM says, "The default initialization of an object of
+      --  type Constant_Reference_Type or Reference_Type propagates
+      --  Program_Error."
+   end record;
+
+   type Reference_Type
+     (Element : not null access Element_Type) is
+   record
+      Control : Reference_Control_Type :=
+        (raise Program_Error with "default initialized reference");
+      --  The RM says, "The default initialization of an object of
+      --  type Constant_Reference_Type or Reference_Type propagates
+      --  Program_Error."
+   end record;
+
+   --  The following four streaming-related subprograms could be
+   --  deleted (the two reference types are limited as a result of
+   --  AI22-0082, so streaming operations are not available for them).
+   --  But we do not want to perform this cleanup only in this unit - the
+   --  same change should be made for all the container generics.
+   --  In particular, we want to minimize differences between this unit
+   --  and the corresponding unbounded unit (Ada.Indefinite_Holders).
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type);
+
+   for Constant_Reference_Type'Read use Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type);
+
+   for Reference_Type'Read use Read;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type);
+
+   for Constant_Reference_Type'Write use Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type);
+
+   for Reference_Type'Write use Write;
+
+   Empty_Holder : constant Holder := (Controlled with
+     Busy => 0,
+     Handle => null,
+     Element => null,
+     Wrapper => (Bound => 0, others => <>));
+
+end Ada.Containers.Bounded_Indefinite_Holders;
diff --git a/gcc/ada/libgnat/a-coboho.ads b/gcc/ada/libgnat/a-coboho.ads
index ad3f3a9278b1..6709a9f73f0e 100644
--- a/gcc/ada/libgnat/a-coboho.ads
+++ b/gcc/ada/libgnat/a-coboho.ads
@@ -69,6 +69,10 @@ package Ada.Containers.Bounded_Holders is
    --  The 'Size of each Element_Type object must be a multiple of
    --  System.Storage_Unit; e.g. creating Holders from 5-bit objects won't
    --  work.
+   --
+   --  Do not confuse this GNAT-defined unit with the similar (similar
+   --  in both name and functionality) predefined unit
+   --  Ada.Containers.Bounded_Indefinite_Holders described in Ada RM A.18.32.
 
    type Holder is private
      with Preelaborable_Initialization
diff --git a/gcc/ada/libgnat/a-undesu.ads b/gcc/ada/libgnat/a-undesu.ads
index 666572530dd2..8c76590c8835 100644
--- a/gcc/ada/libgnat/a-undesu.ads
+++ b/gcc/ada/libgnat/a-undesu.ads
@@ -16,4 +16,5 @@
 with System.Storage_Pools.Subpools;
 
 procedure Ada.Unchecked_Deallocate_Subpool
-  (Subpool : in out System.Storage_Pools.Subpools.Subpool_Handle);
+  (Subpool : in out System.Storage_Pools.Subpools.Subpool_Handle)
+  with Preelaborate;

Reply via email to