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
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
|
-- CXACC01.A
--
-- Grant of Unlimited Rights
--
-- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
-- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
-- unlimited rights in the software and documentation contained herein.
-- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
-- this public release, the Government intends to confer upon all
-- recipients unlimited rights equal to those held by the Government.
-- 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.
--*
--
-- OBJECTIVE:
-- Check that the use of 'Class'Output and 'Class'Input allow stream
-- manipulation of objects of non-limited class-wide types.
--
-- TEST DESCRIPTION:
-- This test demonstrates the uses of 'Class'Output and 'Class'Input
-- in moving objects of a particular class to and from a stream file.
-- A procedure uses a class-wide parameter to move objects of specific
-- types in the class to the stream, using the 'Class'Output attribute
-- of the root type of the class. A function returns a class-wide object,
-- using the 'Class'Input attribute of the root type of the class to
-- extract the object from the stream.
-- A field-by-field comparison of record objects is performed to validate
-- the data read from the stream. Operator precedence rules are used
-- in the comparison rather than parentheses.
--
-- APPLICABILITY CRITERIA:
-- This test is applicable to all implementations capable of supporting
-- external Stream_IO files.
--
--
-- CHANGE HISTORY:
-- 06 Dec 94 SAIC ACVC 2.0
-- 14 Nov 95 SAIC Corrected prefix of 'Tag attribute for ACVC 2.0.1.
-- 24 Aug 96 SAIC Changed a call to "Create" to "Reset".
-- 26 Feb 97 CTA.PWB Allowed for non-support of some IO operations.
--!
with FXACC00, Ada.Streams.Stream_IO, Ada.Tags, Report;
procedure CXACC01 is
Order_File : Ada.Streams.Stream_IO.File_Type;
Order_Stream : Ada.Streams.Stream_IO.Stream_Access;
Order_Filename : constant String :=
Report.Legal_File_Name ( Nam => "CXACC01" );
Incomplete : exception;
begin
Report.Test ("CXACC01", "Check that the use of 'Class'Output " &
"and 'Class'Input allow stream manipulation " &
"of objects of non-limited class-wide types");
Test_for_Stream_IO_Support:
begin
-- If an implementation does not support Stream_IO in a particular
-- environment, the exception Use_Error or Name_Error will be raised on
-- calls to various Stream_IO operations. This block statement
-- encloses a call to Create, which should produce an exception in a
-- non-supportive environment. These exceptions will be handled to
-- produce a Not_Applicable result.
Ada.Streams.Stream_IO.Create (Order_File,
Ada.Streams.Stream_IO.Out_File,
Order_Filename);
exception
when Ada.Streams.Stream_IO.Use_Error | Ada.Streams.Stream_IO.Name_Error =>
Report.Not_Applicable
( "Files not supported - Create as Out_File for Stream_IO" );
raise Incomplete;
end Test_for_Stream_IO_Support;
Operational_Test_Block:
declare
-- Store tag values associated with objects of tagged types.
TC_Box_Office_Tag : constant String :=
Ada.Tags.External_Tag(FXACC00.Ticket_Request'Tag);
TC_Summer_Tag : constant String :=
Ada.Tags.External_Tag(FXACC00.Subscriber_Request'Tag);
TC_Mayoral_Tag : constant String :=
Ada.Tags.External_Tag(FXACC00.VIP_Request'Tag);
TC_Late_Tag : constant String :=
Ada.Tags.External_Tag(FXACC00.Last_Minute_Request'Tag);
-- The following procedure will take an object of the Ticket_Request
-- class and output it to the stream. Objects of any extended type
-- in the class can be output to the stream with this procedure.
procedure Order_Entry (Order : FXACC00.Ticket_Request'Class) is
begin
FXACC00.Ticket_Request'Class'Output (Order_Stream, Order);
end Order_Entry;
-- The following function will retrieve from the stream an object of
-- the Ticket_Request class.
function Order_Retrieval return FXACC00.Ticket_Request'Class is
begin
return FXACC00.Ticket_Request'Class'Input (Order_Stream);
end Order_Retrieval;
begin
Order_Stream := Ada.Streams.Stream_IO.Stream (Order_File);
-- Store the data objects in the stream.
-- Each of the objects is of a different type within the class.
Order_Entry (FXACC00.Box_Office_Request); -- Object of root type
Order_Entry (FXACC00.Summer_Subscription); -- Obj. of extended type
Order_Entry (FXACC00.Mayoral_Ticket_Request); -- Obj. of extended type
Order_Entry (FXACC00.Late_Request); -- Object of twice
-- extended type.
-- Reset mode of stream to In_File prior to reading data from it.
Reset1:
begin
Ada.Streams.Stream_IO.Reset (Order_File,
Ada.Streams.Stream_IO.In_File);
exception
when Ada.Streams.Stream_IO.Use_Error =>
Report.Not_Applicable
( "Reset to In_File not supported for Stream_IO - 1" );
raise Incomplete;
end Reset1;
Process_Order_Block:
declare
use FXACC00;
-- Declare variables of the root type class,
-- and initialize them with class-wide objects returned from
-- the stream as function result.
Order_1 : Ticket_Request'Class := Order_Retrieval;
Order_2 : Ticket_Request'Class := Order_Retrieval;
Order_3 : Ticket_Request'Class := Order_Retrieval;
Order_4 : Ticket_Request'Class := Order_Retrieval;
-- Declare objects of the specific types from within the class
-- that correspond to the types of the data written to the
-- stream. Perform a type conversion on the class-wide objects.
Ticket_Order : Ticket_Request :=
Ticket_Request(Order_1);
Subscriber_Order : Subscriber_Request :=
Subscriber_Request(Order_2);
VIP_Order : VIP_Request :=
VIP_Request(Order_3);
Last_Minute_Order : Last_Minute_Request :=
Last_Minute_Request(Order_4);
begin
-- Perform a field-by-field comparison of all the class-wide
-- objects input from the stream with specific type objects
-- originally written to the stream.
if Ticket_Order.Location /=
Box_Office_Request.Location or
Ticket_Order.Number_Of_Tickets /=
Box_Office_Request.Number_Of_Tickets
then
Report.Failed ("Ticket_Request object validation failure");
end if;
if Subscriber_Order.Location /=
Summer_Subscription.Location or
Subscriber_Order.Number_Of_Tickets /=
Summer_Subscription.Number_Of_Tickets or
Subscriber_Order.Subscription_Number /=
Summer_Subscription.Subscription_Number
then
Report.Failed ("Subscriber_Request object validation failure");
end if;
if VIP_Order.Location /=
Mayoral_Ticket_Request.Location or
VIP_Order.Number_Of_Tickets /=
Mayoral_Ticket_Request.Number_Of_Tickets or
VIP_Order.Rank /=
Mayoral_Ticket_Request.Rank
then
Report.Failed ("VIP_Request object validation failure");
end if;
if Last_Minute_Order.Location /=
Late_Request.Location or
Last_Minute_Order.Number_Of_Tickets /=
Late_Request.Number_Of_Tickets or
Last_Minute_Order.Rank /=
Late_Request.Rank or
Last_Minute_Order.Special_Consideration /=
Late_Request.Special_Consideration or
Last_Minute_Order.Donation /=
Late_Request.Donation
then
Report.Failed ("Last_Minute_Request object validation failure");
end if;
-- Verify tag values from before and after processing.
-- The 'Tag attribute is used with objects of a class-wide type.
if TC_Box_Office_Tag /=
Ada.Tags.External_Tag(Order_1'Tag)
then
Report.Failed("Failed tag comparison - 1");
end if;
if TC_Summer_Tag /=
Ada.Tags.External_Tag(Order_2'Tag)
then
Report.Failed("Failed tag comparison - 2");
end if;
if TC_Mayoral_Tag /=
Ada.Tags.External_Tag(Order_3'Tag)
then
Report.Failed("Failed tag comparison - 3");
end if;
if TC_Late_Tag /=
Ada.Tags.External_Tag(Order_4'Tag)
then
Report.Failed("Failed tag comparison - 4");
end if;
end Process_Order_Block;
-- After all the data has been correctly extracted, the file
-- should be empty.
if not Ada.Streams.Stream_IO.End_Of_File (Order_File) then
Report.Failed ("Stream file not empty");
end if;
exception
when Incomplete =>
raise;
when Constraint_Error =>
Report.Failed ("Constraint_Error raised in Operational Block");
when others =>
Report.Failed ("Exception raised in Operational Test Block");
end Operational_Test_Block;
Deletion:
begin
if Ada.Streams.Stream_IO.Is_Open (Order_File) then
Ada.Streams.Stream_IO.Delete (Order_File);
else
Ada.Streams.Stream_IO.Open (Order_File,
Ada.Streams.Stream_IO.Out_File,
Order_Filename);
Ada.Streams.Stream_IO.Delete (Order_File);
end if;
exception
when others =>
Report.Failed
( "Delete not properly implemented for Stream_IO" );
end Deletion;
Report.Result;
exception
when Incomplete =>
Report.Result;
when others =>
Report.Failed ( "Unexpected exception" );
Report.Result;
end CXACC01;
|
