gcc/testsuite/gnat.dg/opt41_pkg.adb

   1 with Ada.Streams; use Ada.Streams;
   2
   3 package body Opt41_Pkg is
   4
   5    type Wstream is new Root_Stream_Type with record
   6       S : Unbounded_String;
   7    end record;
   8
   9    procedure Read (Stream : in out Wstream;
  10                    Item   : out Stream_Element_Array;
  11                    Last   : out Stream_Element_Offset) is null;
  12
  13    procedure Write (Stream : in out Wstream; Item : Stream_Element_Array) is
  14    begin
  15       for J in Item'Range loop
  16          Append (Stream.S, Character'Val (Item (J)));
  17       end loop;
  18    end Write;
  19
  20    function Rec_Write (R : Rec) return Unbounded_String is
  21       S : aliased Wstream;
  22    begin
  23       Rec'Output (S'Access, R);
  24       return S.S;
  25    end Rec_Write;
  26
  27    type Rstream is new Root_Stream_Type with record
  28       S   : String_Access;
  29       Idx : Integer := 1;
  30    end record;
  31
  32    procedure Write (Stream : in out Rstream; Item : Stream_Element_Array) is null;
  33
  34    procedure Read (Stream : in out Rstream;
  35                    Item   : out Stream_Element_Array;
  36                    Last   : out Stream_Element_Offset) is
  37    begin
  38       Last := Stream_Element_Offset'Min
  39          (Item'Last, Item'First + Stream_Element_Offset (Stream.S'Last - Stream.Idx));
  40       for I in Item'First .. Last loop
  41          Item (I) := Stream_Element (Character'Pos (Stream.S (Stream.Idx)));
  42          Stream.Idx := Stream.Idx + 1;
  43       end loop;
  44    end Read;
  45
  46    function Rec_Read (Str : String_Access) return Rec is
  47       S : aliased Rstream;
  48    begin
  49       S.S := Str;
  50       return Rec'Input (S'Access);
  51    end Rec_Read;
  52
  53 end Opt41_Pkg;