1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
-- FDD2A00.A
--
-- Grant of Unlimited Rights
--
-- The Ada Conformity Assessment Authority (ACAA) holds unlimited
-- rights in the software and documentation contained herein. Unlimited
-- rights are the same as those granted by the U.S. Government for older
-- parts of the Ada Conformity Assessment Test Suite, and are defined
-- in DFAR 252.227-7013(a)(19). By making this public release, the ACAA
-- intends to confer upon all recipients unlimited rights equal to those
-- held by the ACAA. These rights include rights to use, duplicate,
-- release or disclose the released technical data and computer software
-- in whole or in part, in any manner and for any purpose whatsoever, and
-- to have or permit others to do so.
--
-- DISCLAIMER
--
-- ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
-- DISCLOSED ARE AS IS. THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
-- WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
-- SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
-- OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
-- PARTICULAR PURPOSE OF SAID MATERIAL.
--
--
-- FOUNDATION DESCRIPTION:
-- This foundation provides the basis for testing user-defined stream
-- attributes. It provides operations which count calls to stream
-- attributes.
--
-- CHANGE HISTORY:
-- 30 JUL 2001 PHL Initial version.
-- 5 DEC 2001 RLB Reformatted for ACATS.
--
with Ada.Streams;
use Ada.Streams;
package FDD2A00 is
type Kinds is (Read, Write, Input, Output);
type Counts is array (Kinds) of Natural;
type My_Stream (Size : Stream_Element_Count) is new Root_Stream_Type with
record
First : Stream_Element_Offset := 1;
Last : Stream_Element_Offset := 0;
Contents : Stream_Element_Array (1 .. Size);
end record;
procedure Clear (Stream : in out My_Stream);
procedure Read (Stream : in out My_Stream;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset);
procedure Write (Stream : in out My_Stream; Item : in Stream_Element_Array);
generic
type T (<>) is limited private;
with procedure Actual_Write
(Stream : access Root_Stream_Type'Class; Item : T);
with function Actual_Input
(Stream : access Root_Stream_Type'Class) return T;
with procedure Actual_Read (Stream : access Root_Stream_Type'Class;
Item : out T);
with procedure Actual_Output
(Stream : access Root_Stream_Type'Class; Item : T);
package Counting_Stream_Ops is
procedure Write (Stream : access Root_Stream_Type'Class; Item : T);
function Input (Stream : access Root_Stream_Type'Class) return T;
procedure Read (Stream : access Root_Stream_Type'Class; Item : out T);
procedure Output (Stream : access Root_Stream_Type'Class; Item : T);
function Get_Counts return Counts;
end Counting_Stream_Ops;
end FDD2A00;
package body FDD2A00 is
procedure Clear (Stream : in out My_Stream) is
begin
Stream.First := 1;
Stream.Last := 0;
end Clear;
procedure Read (Stream : in out My_Stream;
Item : out Stream_Element_Array;
Last : out Stream_Element_Offset) is
begin
if Item'Length >= Stream.Last - Stream.First + 1 then
Item (Item'First .. Item'First + Stream.Last - Stream.First) :=
Stream.Contents (Stream.First .. Stream.Last);
Last := Item'First + Stream.Last - Stream.First;
Stream.First := Stream.Last + 1;
else
Item := Stream.Contents (Stream.First ..
Stream.First + Item'Length - 1);
Last := Item'Last;
Stream.First := Stream.First + Item'Length;
end if;
end Read;
procedure Write (Stream : in out My_Stream;
Item : in Stream_Element_Array) is
begin
Stream.Contents (Stream.Last + 1 .. Stream.Last + Item'Length) := Item;
Stream.Last := Stream.Last + Item'Length;
end Write;
package body Counting_Stream_Ops is
Cnts : Counts := (others => 0);
procedure Write (Stream : access Root_Stream_Type'Class; Item : T) is
begin
Cnts (Write) := Cnts (Write) + 1;
Actual_Write (Stream, Item);
end Write;
function Input (Stream : access Root_Stream_Type'Class) return T is
begin
Cnts (Input) := Cnts (Input) + 1;
return Actual_Input (Stream);
end Input;
procedure Read (Stream : access Root_Stream_Type'Class; Item : out T) is
begin
Cnts (Read) := Cnts (Read) + 1;
Actual_Read (Stream, Item);
end Read;
procedure Output (Stream : access Root_Stream_Type'Class; Item : T) is
begin
Cnts (Output) := Cnts (Output) + 1;
Actual_Output (Stream, Item);
end Output;
function Get_Counts return Counts is
begin
return Cnts;
end Get_Counts;
end Counting_Stream_Ops;
end FDD2A00;
|
