[Ada] AI12-0293-1 Implement storage streams

2020-06-18  Bob Duff  <duff@adacore.com>

gcc/ada/

	* libgnat/a-strsto.ads, libgnat/a-ststbo.adb,
	libgnat/a-ststbo.ads, libgnat/a-ststun.adb,
	libgnat/a-ststun.ads: New files, containing packages
	Ada.Streams.Storage, Ada.Streams.Storage.Bounded, and
	Ada.Streams.Storage.Unbounded.
	* impunit.adb, Makefile.rtl: Add new file names.

5 files changed, 476 insertions, 0 deletions

diff --git a/gcc/ada/libgnat/a-strsto.ads b/gcc/ada/libgnat/a-strsto.ads
new file mode 100644
index 0000000..1e2814b
--- /dev/null
+++ b/gcc/ada/libgnat/a-strsto.ads
@@ -0,0 +1,45 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--                   A D A . S T R E A M S . S T O R A G E                  --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--             Copyright (C) 2020, 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/>.                                          --
+--                                                                          --
+------------------------------------------------------------------------------
+
+pragma Ada_2020;
+package Ada.Streams.Storage with Pure is
+
+   type Storage_Stream_Type is abstract new Root_Stream_Type with private;
+
+   function Element_Count
+     (Stream : Storage_Stream_Type) return Stream_Element_Count is abstract;
+
+   procedure Clear (Stream : in out Storage_Stream_Type) is abstract;
+
+private
+   type Storage_Stream_Type is abstract new Root_Stream_Type with null record;
+end Ada.Streams.Storage;
diff --git a/gcc/ada/libgnat/a-ststbo.adb b/gcc/ada/libgnat/a-ststbo.adb
new file mode 100644
index 0000000..3b31acc
--- /dev/null
+++ b/gcc/ada/libgnat/a-ststbo.adb
@@ -0,0 +1,115 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--           A D A . S T R E A M S . S T O R A G E . B O U N D E D          --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--             Copyright (C) 2020, 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/>.                                          --
+--                                                                          --
+------------------------------------------------------------------------------
+
+pragma Ada_2020;
+package body Ada.Streams.Storage.Bounded is
+
+   ----------
+   -- Read --
+   ----------
+
+   overriding procedure Read
+     (Stream : in out Stream_Type; Item : out Stream_Element_Array;
+      Last   :    out Stream_Element_Offset)
+   is
+      EA : Stream_Element_Array renames
+        Stream.Elements (1 .. Element_Count (Stream));
+   begin
+      if Item'Length = 0 then
+         Last := Item'First - 1;
+
+      --  If the entire content of the stream fits in Item, then copy it and
+      --  clear the stream. This is likely the usual case.
+
+      elsif Element_Count (Stream) <= Item'Length then
+         Last := Item'First + Element_Count (Stream) - 1;
+         Item (Item'First .. Last) := EA;
+         Clear (Stream);
+
+      --  Otherwise, copy as much into Item as will fit. Then slide the
+      --  remaining part of the stream down, and compute the new Count.
+      --  We expect this to be the unusual case, so the cost of copying
+      --  the remaining part probably doesn't matter.
+
+      else
+         Last := Item'Last;
+
+         declare
+            New_Count : constant Stream_Element_Count :=
+              Element_Count (Stream) - Item'Length;
+         begin
+            Item := EA (1 .. Item'Length);
+            EA (1 .. New_Count) :=
+              EA (Element_Count (Stream) - New_Count + 1 ..
+                  Element_Count (Stream));
+            Stream.Count := New_Count;
+         end;
+      end if;
+   end Read;
+
+   -----------
+   -- Write --
+   -----------
+
+   overriding procedure Write
+     (Stream : in out Stream_Type; Item : Stream_Element_Array)
+   is
+      pragma Assert
+        (Element_Count (Stream) + Item'Length <= Stream.Max_Elements
+           or else (raise Constraint_Error));
+      --  That is a precondition in the RM
+
+      New_Count : constant Stream_Element_Count :=
+        Element_Count (Stream) + Item'Length;
+   begin
+      Stream.Elements (Element_Count (Stream) + 1 .. New_Count) := Item;
+      Stream.Count := New_Count;
+   end Write;
+
+   -------------------
+   -- Element_Count --
+   -------------------
+
+   overriding function Element_Count
+     (Stream : Stream_Type) return Stream_Element_Count
+   is
+   begin
+      return Stream.Count;
+   end Element_Count;
+
+   -----------
+   -- Clear --
+   -----------
+
+   overriding procedure Clear (Stream : in out Stream_Type)
+   is
+   begin
+      Stream.Count := 0;
+   end Clear;
+
+end Ada.Streams.Storage.Bounded;
diff --git a/gcc/ada/libgnat/a-ststbo.ads b/gcc/ada/libgnat/a-ststbo.ads
new file mode 100644
index 0000000..1ce6d90
--- /dev/null
+++ b/gcc/ada/libgnat/a-ststbo.ads
@@ -0,0 +1,74 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--           A D A . S T R E A M S . S T O R A G E . B O U N D E D          --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--             Copyright (C) 2020, 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/>.                                          --
+--                                                                          --
+------------------------------------------------------------------------------
+
+pragma Ada_2020;
+package Ada.Streams.Storage.Bounded with Pure is
+
+   type Stream_Type (Max_Elements : Stream_Element_Count) is
+     new Storage_Stream_Type with private with
+      Default_Initial_Condition => Element_Count (Stream_Type) = 0;
+
+   overriding procedure Read
+     (Stream : in out Stream_Type; Item : out Stream_Element_Array;
+      Last   :    out Stream_Element_Offset)
+       with Post =>
+         (declare
+            Num_Read : constant Stream_Element_Count :=
+              Stream_Element_Count'Min
+                (Element_Count (Stream)'Old, Item'Length);
+          begin
+            Last = Num_Read + Item'First - 1
+              and
+            Element_Count (Stream) =
+              Element_Count (Stream)'Old - Num_Read);
+
+   overriding procedure Write
+     (Stream : in out Stream_Type; Item : Stream_Element_Array) with
+      Post => Element_Count (Stream) =
+      Element_Count (Stream)'Old + Item'Length;
+
+   overriding function Element_Count
+     (Stream : Stream_Type) return Stream_Element_Count with
+      Post => Element_Count'Result <= Stream.Max_Elements;
+
+   overriding procedure Clear (Stream : in out Stream_Type) with
+      Post => Element_Count (Stream) = 0;
+
+private
+
+   type Stream_Type (Max_Elements : Stream_Element_Count) is
+     new Storage_Stream_Type with record
+      Count : Stream_Element_Count := 0;
+      Elements : Stream_Element_Array (1 .. Max_Elements);
+   end record;
+
+end Ada.Streams.Storage.Bounded;
diff --git a/gcc/ada/libgnat/a-ststun.adb b/gcc/ada/libgnat/a-ststun.adb
new file mode 100644
index 0000000..f2f433b
--- /dev/null
+++ b/gcc/ada/libgnat/a-ststun.adb
@@ -0,0 +1,151 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--         A D A . S T R E A M S . S T O R A G E . U N B O U N D E D        --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--             Copyright (C) 2020, 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/>.                                          --
+--                                                                          --
+------------------------------------------------------------------------------
+
+pragma Ada_2020;
+with Ada.Unchecked_Deallocation;
+package body Ada.Streams.Storage.Unbounded is
+
+   procedure Free is new Ada.Unchecked_Deallocation
+     (Elements_Type, Elements_Access);
+
+   --------------
+   -- Finalize --
+   --------------
+
+   overriding procedure Finalize (X : in out Controlled_Elements_Access) is
+   begin
+      if X.A /= Empty_Elements'Access then
+         Free (X.A);
+      end if;
+   end Finalize;
+
+   ----------
+   -- Read --
+   ----------
+
+   overriding procedure Read
+     (Stream : in out Stream_Type; Item : out Stream_Element_Array;
+      Last   :    out Stream_Element_Offset)
+   is
+      EA : Stream_Element_Array renames
+        Stream.Elements.A.EA (1 .. Element_Count (Stream));
+   begin
+      if Item'Length = 0 then
+         Last := Item'First - 1;
+
+      --  If the entire content of the stream fits in Item, then copy it and
+      --  clear the stream. This is likely the usual case.
+
+      elsif Element_Count (Stream) <= Item'Length then
+         Last := Item'First + Element_Count (Stream) - 1;
+         Item (Item'First .. Last) := EA;
+         Clear (Stream);
+
+      --  Otherwise, copy as much into Item as will fit. Then slide the
+      --  remaining part of the stream down, and compute the new Count.
+      --  We expect this to be the unusual case, so the cost of copying
+      --  the remaining part probably doesn't matter.
+
+      else
+         Last := Item'Last;
+
+         declare
+            New_Count : constant Stream_Element_Count :=
+              Element_Count (Stream) - Item'Length;
+         begin
+            Item := EA (1 .. Item'Length);
+            EA (1 .. New_Count) :=
+              EA (Element_Count (Stream) - New_Count + 1 ..
+                  Element_Count (Stream));
+            Stream.Count := New_Count;
+         end;
+      end if;
+   end Read;
+
+   -----------
+   -- Write --
+   -----------
+
+   overriding procedure Write
+     (Stream : in out Stream_Type; Item : Stream_Element_Array)
+   is
+      New_Count : constant Stream_Element_Count :=
+        Element_Count (Stream) + Item'Length;
+   begin
+      --  Check whether we need to grow the array. If so, then if the Stream is
+      --  empty, allocate a goodly amount. Otherwise double the length, for
+      --  amortized efficiency. In any case, we need to make sure it's at least
+      --  big enough for New_Count.
+
+      if New_Count > Stream.Elements.A.Last then
+         declare
+            New_Last : Stream_Element_Index :=
+              (if Stream.Elements.A.Last = 0 then 2**10 -- goodly amount
+               else Stream.Elements.A.Last * 2);
+            Old_Elements : Elements_Access := Stream.Elements.A;
+         begin
+            if New_Last < New_Count then
+               New_Last := New_Count;
+            end if;
+
+            Stream.Elements.A := new Elements_Type (Last => New_Last);
+
+            if Old_Elements /= Empty_Elements'Access then
+               Stream.Elements.A.EA (Old_Elements.EA'Range) := Old_Elements.EA;
+               Free (Old_Elements);
+            end if;
+         end;
+      end if;
+
+      Stream.Elements.A.EA (Element_Count (Stream) + 1 .. New_Count) := Item;
+      Stream.Count := New_Count;
+   end Write;
+
+   -------------------
+   -- Element_Count --
+   -------------------
+
+   overriding function Element_Count
+     (Stream : Stream_Type) return Stream_Element_Count
+   is
+   begin
+      return Stream.Count;
+   end Element_Count;
+
+   -----------
+   -- Clear --
+   -----------
+
+   overriding procedure Clear (Stream : in out Stream_Type) is
+   begin
+      Stream.Count := 0;
+      --  We don't free Stream.Elements here, because we want to reuse it if
+      --  there are more Write calls.
+   end Clear;
+
+end Ada.Streams.Storage.Unbounded;
diff --git a/gcc/ada/libgnat/a-ststun.ads b/gcc/ada/libgnat/a-ststun.ads
new file mode 100644
index 0000000..2f01fa0
--- /dev/null
+++ b/gcc/ada/libgnat/a-ststun.ads
@@ -0,0 +1,91 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--         A D A . S T R E A M S . S T O R A G E . U N B O U N D E D        --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--             Copyright (C) 2020, 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/>.                                          --
+--                                                                          --
+------------------------------------------------------------------------------
+
+pragma Ada_2020;
+private with Ada.Finalization;
+package Ada.Streams.Storage.Unbounded with Preelaborate is
+
+   type Stream_Type is new Storage_Stream_Type with private with
+      Default_Initial_Condition => Element_Count (Stream_Type) = 0;
+
+   overriding procedure Read
+     (Stream : in out Stream_Type; Item : out Stream_Element_Array;
+      Last   :    out Stream_Element_Offset)
+       with Post =>
+         (declare
+            Num_Read : constant Stream_Element_Count :=
+              Stream_Element_Count'Min
+                (Element_Count (Stream)'Old, Item'Length);
+          begin
+            Last = Num_Read + Item'First - 1
+              and
+            Element_Count (Stream) =
+              Element_Count (Stream)'Old - Num_Read);
+
+   overriding procedure Write
+     (Stream : in out Stream_Type; Item : Stream_Element_Array) with
+      Post => Element_Count (Stream) =
+      Element_Count (Stream)'Old + Item'Length;
+
+   overriding function Element_Count
+     (Stream : Stream_Type) return Stream_Element_Count;
+
+   overriding procedure Clear (Stream : in out Stream_Type) with
+      Post => Element_Count (Stream) = 0;
+
+private
+
+   subtype Stream_Element_Index is Stream_Element_Count
+     range 1 .. Stream_Element_Count'Last;
+
+   type Elements_Type (Last : Stream_Element_Count) is limited record
+      EA : Stream_Element_Array (1 .. Last);
+   end record;
+
+   Empty_Elements : aliased Elements_Type := (Last => 0, EA => (others => <>));
+
+   type Elements_Access is access all Elements_Type;
+
+   type Controlled_Elements_Access is
+     new Finalization.Limited_Controlled with record
+      A : Elements_Access;
+   end record;
+
+   overriding procedure Finalize (X : in out Controlled_Elements_Access);
+
+   type Stream_Type is new Storage_Stream_Type with record
+      Elements : Controlled_Elements_Access :=
+        (Finalization.Limited_Controlled with A => Empty_Elements'Access);
+      Count : Stream_Element_Count := 0;
+   end record;
+
+end Ada.Streams.Storage.Unbounded;