2018-03-15 Steven G. Kargl <kargl@gcc.gnu.org>
[official-gcc.git] / gcc / testsuite / gnat.dg / opt41_pkg.adb
blobc43c1bfdf049dcc0acbd5c0388b0d93007d873b8
1 with Ada.Streams; use Ada.Streams;
3 package body Opt41_Pkg is
5 type Wstream is new Root_Stream_Type with record
6 S : Unbounded_String;
7 end record;
9 procedure Read (Stream : in out Wstream;
10 Item : out Stream_Element_Array;
11 Last : out Stream_Element_Offset) is null;
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;
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;
27 type Rstream is new Root_Stream_Type with record
28 S : String_Access;
29 Idx : Integer := 1;
30 end record;
32 procedure Write (Stream : in out Rstream; Item : Stream_Element_Array) is null;
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;
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;
53 end Opt41_Pkg;