3 -- Grant of Unlimited Rights
5 -- The Ada Conformity Assessment Authority (ACAA) holds unlimited
6 -- rights in the software and documentation contained herein. Unlimited
7 -- rights are the same as those granted by the U.S. Government for older
8 -- parts of the Ada Conformity Assessment Test Suite, and are defined
9 -- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
10 -- intends to confer upon all recipients unlimited rights equal to those
11 -- held by the ACAA. These rights include rights to use, duplicate,
12 -- release or disclose the released technical data and computer software
13 -- in whole or in part, in any manner and for any purpose whatsoever, and
14 -- to have or permit others to do so.
18 -- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
19 -- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
20 -- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
21 -- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
22 -- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
23 -- PARTICULAR PURPOSE OF SAID MATERIAL.
26 -- FOUNDATION DESCRIPTION:
27 -- This foundation provides the basis for testing user-defined stream
28 -- attributes. It provides operations which count calls to stream
32 -- 30 JUL 2001 PHL Initial version.
33 -- 5 DEC 2001 RLB Reformatted for ACATS.
40 type Kinds
is (Read
, Write
, Input
, Output
);
41 type Counts
is array (Kinds
) of Natural;
44 type My_Stream
(Size
: Stream_Element_Count
) is new Root_Stream_Type
with
46 First
: Stream_Element_Offset
:= 1;
47 Last
: Stream_Element_Offset
:= 0;
48 Contents
: Stream_Element_Array
(1 .. Size
);
51 procedure Clear
(Stream
: in out My_Stream
);
53 procedure Read
(Stream
: in out My_Stream
;
54 Item
: out Stream_Element_Array
;
55 Last
: out Stream_Element_Offset
);
57 procedure Write
(Stream
: in out My_Stream
; Item
: in Stream_Element_Array
);
61 type T
(<>) is limited private;
62 with procedure Actual_Write
63 (Stream
: access Root_Stream_Type
'Class; Item
: T
);
64 with function Actual_Input
65 (Stream
: access Root_Stream_Type
'Class) return T
;
66 with procedure Actual_Read
(Stream
: access Root_Stream_Type
'Class;
68 with procedure Actual_Output
69 (Stream
: access Root_Stream_Type
'Class; Item
: T
);
70 package Counting_Stream_Ops
is
72 procedure Write
(Stream
: access Root_Stream_Type
'Class; Item
: T
);
73 function Input
(Stream
: access Root_Stream_Type
'Class) return T
;
74 procedure Read
(Stream
: access Root_Stream_Type
'Class; Item
: out T
);
75 procedure Output
(Stream
: access Root_Stream_Type
'Class; Item
: T
);
77 function Get_Counts
return Counts
;
79 end Counting_Stream_Ops
;
82 package body FDD2A00
is
84 procedure Clear
(Stream
: in out My_Stream
) is
90 procedure Read
(Stream
: in out My_Stream
;
91 Item
: out Stream_Element_Array
;
92 Last
: out Stream_Element_Offset
) is
94 if Item
'Length >= Stream
.Last
- Stream
.First
+ 1 then
95 Item
(Item
'First .. Item
'First + Stream
.Last
- Stream
.First
) :=
96 Stream
.Contents
(Stream
.First
.. Stream
.Last
);
97 Last
:= Item
'First + Stream
.Last
- Stream
.First
;
98 Stream
.First
:= Stream
.Last
+ 1;
100 Item
:= Stream
.Contents
(Stream
.First
..
101 Stream
.First
+ Item
'Length - 1);
103 Stream
.First
:= Stream
.First
+ Item
'Length;
107 procedure Write
(Stream
: in out My_Stream
;
108 Item
: in Stream_Element_Array
) is
110 Stream
.Contents
(Stream
.Last
+ 1 .. Stream
.Last
+ Item
'Length) := Item
;
111 Stream
.Last
:= Stream
.Last
+ Item
'Length;
115 package body Counting_Stream_Ops
is
116 Cnts
: Counts
:= (others => 0);
118 procedure Write
(Stream
: access Root_Stream_Type
'Class; Item
: T
) is
120 Cnts
(Write
) := Cnts
(Write
) + 1;
121 Actual_Write
(Stream
, Item
);
124 function Input
(Stream
: access Root_Stream_Type
'Class) return T
is
126 Cnts
(Input
) := Cnts
(Input
) + 1;
127 return Actual_Input
(Stream
);
130 procedure Read
(Stream
: access Root_Stream_Type
'Class; Item
: out T
) is
132 Cnts
(Read
) := Cnts
(Read
) + 1;
133 Actual_Read
(Stream
, Item
);
136 procedure Output
(Stream
: access Root_Stream_Type
'Class; Item
: T
) is
138 Cnts
(Output
) := Cnts
(Output
) + 1;
139 Actual_Output
(Stream
, Item
);
142 function Get_Counts
return Counts
is
147 end Counting_Stream_Ops
;