|
111
|
1 -- CXACA01.A
|
|
|
2 --
|
|
|
3 -- Grant of Unlimited Rights
|
|
|
4 --
|
|
|
5 -- Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
|
|
|
6 -- F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
|
|
|
7 -- unlimited rights in the software and documentation contained herein.
|
|
|
8 -- Unlimited rights are defined in DFAR 252.227-7013(a)(19). By making
|
|
|
9 -- this public release, the Government intends to confer upon all
|
|
|
10 -- recipients unlimited rights equal to those held by the Government.
|
|
|
11 -- These rights include rights to use, duplicate, release or disclose the
|
|
|
12 -- released technical data and computer software in whole or in part, in
|
|
|
13 -- any manner and for any purpose whatsoever, and to have or permit others
|
|
|
14 -- to do so.
|
|
|
15 --
|
|
|
16 -- DISCLAIMER
|
|
|
17 --
|
|
|
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.
|
|
|
24 --*
|
|
|
25 --
|
|
|
26 -- OBJECTIVE:
|
|
|
27 -- Check that the default attributes 'Write and 'Read work properly when
|
|
|
28 -- used with objects of a variety of types, including records with
|
|
|
29 -- default discriminants, records without default discriminants, but
|
|
|
30 -- which have the discriminant described in a representation clause for
|
|
|
31 -- the type, and arrays.
|
|
|
32 --
|
|
|
33 -- TEST DESCRIPTION:
|
|
|
34 -- This test simulates a basic sales record system, using Stream_IO to
|
|
|
35 -- allow the storage of heterogeneous data in a single stream file.
|
|
|
36 --
|
|
|
37 -- Four types of data are written to the stream file for each product.
|
|
|
38 -- First, the "header" information on the product is written.
|
|
|
39 -- This is an object of a discriminated (with default) record
|
|
|
40 -- type. This is followed by an integer object containing a count of
|
|
|
41 -- the number of sales data records to follow. The corresponding number
|
|
|
42 -- of sales records follow in the stream. These are of a record type
|
|
|
43 -- with a discriminant without a default, but where the discriminant is
|
|
|
44 -- included in the representation clause for the type. Finally, an
|
|
|
45 -- array object with statistical sales information for the product is
|
|
|
46 -- written to the stream.
|
|
|
47 --
|
|
|
48 -- Objects of both record types specified below (discriminated records
|
|
|
49 -- with defaults, and discriminated records w/o defaults that have the
|
|
|
50 -- discriminant included in a representation clause for the type) should
|
|
|
51 -- have their discriminants included in the stream when using 'Write.
|
|
|
52 -- Likewise, discriminants should be extracted from the stream when
|
|
|
53 -- using 'Read.
|
|
|
54 --
|
|
|
55 -- APPLICABILITY CRITERIA:
|
|
|
56 -- Applicable to all implementations that support external
|
|
|
57 -- Stream_IO files.
|
|
|
58 --
|
|
|
59 --
|
|
|
60 -- CHANGE HISTORY:
|
|
|
61 -- 06 Dec 94 SAIC ACVC 2.0
|
|
|
62 --
|
|
|
63 --!
|
|
|
64
|
|
|
65 with FXACA00;
|
|
|
66 with Ada.Streams.Stream_IO;
|
|
|
67 with Report;
|
|
|
68
|
|
|
69 procedure CXACA01 is
|
|
|
70
|
|
|
71 begin
|
|
|
72
|
|
|
73 Report.Test ("CXACA01", "Check that 'Write and 'Read work properly " &
|
|
|
74 "when used with complex data types");
|
|
|
75
|
|
|
76 Test_for_Stream_IO_Support:
|
|
|
77 declare
|
|
|
78
|
|
|
79 Info_File : Ada.Streams.Stream_IO.File_Type;
|
|
|
80 Info_Stream : Ada.Streams.Stream_IO.Stream_Access;
|
|
|
81 The_Filename : constant String := Report.Legal_File_Name;
|
|
|
82
|
|
|
83 begin
|
|
|
84
|
|
|
85 -- If an implementation does not support Stream_IO in a particular
|
|
|
86 -- environment, the exception Use_Error or Name_Error will be raised on
|
|
|
87 -- calls to various Stream_IO operations. This block statement
|
|
|
88 -- encloses a call to Create, which should produce an exception in a
|
|
|
89 -- non-supportive environment. These exceptions will be handled to
|
|
|
90 -- produce a Not_Applicable result.
|
|
|
91
|
|
|
92 Ada.Streams.Stream_IO.Create (Info_File,
|
|
|
93 Ada.Streams.Stream_IO.Out_File,
|
|
|
94 The_Filename);
|
|
|
95
|
|
|
96 Operational_Test_Block:
|
|
|
97 declare
|
|
|
98
|
|
|
99 begin
|
|
|
100
|
|
|
101 Info_Stream := Ada.Streams.Stream_IO.Stream (Info_File);
|
|
|
102
|
|
|
103 -- Write all of the product information (record, integer, and array
|
|
|
104 -- objects) defined in package FXACA00 into the stream.
|
|
|
105
|
|
|
106 Store_Data_Block:
|
|
|
107 begin
|
|
|
108
|
|
|
109 -- Write information about first product to the stream.
|
|
|
110 FXACA00.Product_Type'Write (Info_Stream, FXACA00.Product_01);
|
|
|
111 Integer'Write (Info_Stream, FXACA00.Sale_Count_01);
|
|
|
112 FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_01);
|
|
|
113 FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_02);
|
|
|
114 FXACA00.Sales_Statistics_Type'Write
|
|
|
115 (Info_Stream, FXACA00.Product_01_Stats);
|
|
|
116
|
|
|
117 -- Write information about second product to the stream.
|
|
|
118 -- Note: No Sales_Record_Type objects.
|
|
|
119 FXACA00.Product_Type'Write (Info_Stream, FXACA00.Product_02);
|
|
|
120 Integer'Write (Info_Stream, FXACA00.Sale_Count_02);
|
|
|
121 FXACA00.Sales_Statistics_Type'Write
|
|
|
122 (Info_Stream, FXACA00.Product_02_Stats);
|
|
|
123
|
|
|
124 -- Write information about third product to the stream.
|
|
|
125 FXACA00.Product_Type'Write (Info_Stream, FXACA00.Product_03);
|
|
|
126 Integer'Write (Info_Stream, FXACA00.Sale_Count_03);
|
|
|
127 FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_03);
|
|
|
128 FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_04);
|
|
|
129 FXACA00.Sales_Record_Type'Write(Info_Stream, FXACA00.Sale_Rec_05);
|
|
|
130 FXACA00.Sales_Statistics_Type'Write
|
|
|
131 (Info_Stream, FXACA00.Product_03_Stats);
|
|
|
132
|
|
|
133 end Store_Data_Block;
|
|
|
134
|
|
|
135
|
|
|
136 Verify_Data_Block:
|
|
|
137 declare
|
|
|
138
|
|
|
139 use FXACA00; -- Used within this block only.
|
|
|
140
|
|
|
141 type Domestic_Rec_Array_Type is
|
|
|
142 array (Positive range <>) of Sales_Record_Type (Domestic);
|
|
|
143
|
|
|
144 type Foreign_Rec_Array_Type is
|
|
|
145 array (Positive range <>) of Sales_Record_Type (Foreign);
|
|
|
146
|
|
|
147 TC_Rec1 : Domestic_Rec_Array_Type (1..2);
|
|
|
148 TC_Rec3 : Foreign_Rec_Array_Type (1..3);
|
|
|
149
|
|
|
150 TC_Product1 : Product_Type;
|
|
|
151 TC_Product2,
|
|
|
152 TC_Product3 : Product_Type (Foreign);
|
|
|
153
|
|
|
154 TC_Count1,
|
|
|
155 TC_Count2,
|
|
|
156 TC_Count3 : Integer := -10; -- Initialized to dummy value.
|
|
|
157
|
|
|
158 TC_Stat1,
|
|
|
159 TC_Stat2,
|
|
|
160 TC_Stat3 : Sales_Statistics_Type := (others => 500);
|
|
|
161
|
|
|
162 begin
|
|
|
163
|
|
|
164 Ada.Streams.Stream_IO.Reset (Info_File,
|
|
|
165 Ada.Streams.Stream_IO.In_File);
|
|
|
166
|
|
|
167 -- Read all of the data that is contained in the stream.
|
|
|
168 -- Compare all data with the original data in package FXACA00
|
|
|
169 -- that was written to the stream.
|
|
|
170 -- The calls to the read attribute are in anticipated order, based
|
|
|
171 -- on the order of data written to the stream. Possible errors,
|
|
|
172 -- such as data placement, overwriting, etc., will be manifest as
|
|
|
173 -- exceptions raised by the attribute during an unsuccessful read
|
|
|
174 -- attempt.
|
|
|
175
|
|
|
176 -- Extract data on first product.
|
|
|
177 Product_Type'Read (Info_Stream, TC_Product1);
|
|
|
178 Integer'Read (Info_Stream, TC_Count1);
|
|
|
179
|
|
|
180 -- Two "domestic" variant sales records will be read from the
|
|
|
181 -- stream.
|
|
|
182 for i in 1 .. TC_Count1 loop
|
|
|
183 Sales_Record_Type'Read (Info_Stream, TC_Rec1(i) );
|
|
|
184 end loop;
|
|
|
185
|
|
|
186 Sales_Statistics_Type'Read (Info_Stream, TC_Stat1);
|
|
|
187
|
|
|
188
|
|
|
189 -- Extract data on second product.
|
|
|
190 Product_Type'Read (Info_Stream, TC_Product2);
|
|
|
191 Integer'Read (Info_Stream, TC_Count2);
|
|
|
192 Sales_Statistics_Type'Read (Info_Stream, TC_Stat2);
|
|
|
193
|
|
|
194
|
|
|
195 -- Extract data on third product.
|
|
|
196 Product_Type'Read (Info_Stream, TC_Product3);
|
|
|
197 Integer'Read (Info_Stream, TC_Count3);
|
|
|
198
|
|
|
199 -- Three "foreign" variant sales records will be read from the
|
|
|
200 -- stream.
|
|
|
201 for i in 1 .. TC_Count3 loop
|
|
|
202 Sales_Record_Type'Read (Info_Stream, TC_Rec3(i) );
|
|
|
203 end loop;
|
|
|
204
|
|
|
205 Sales_Statistics_Type'Read (Info_Stream, TC_Stat3);
|
|
|
206
|
|
|
207
|
|
|
208 -- After all the data has been correctly extracted, the file
|
|
|
209 -- should be empty.
|
|
|
210
|
|
|
211 if not Ada.Streams.Stream_IO.End_Of_File (Info_File) then
|
|
|
212 Report.Failed ("Stream file not empty");
|
|
|
213 end if;
|
|
|
214
|
|
|
215 -- Verify that the data values read from the stream are the same
|
|
|
216 -- as those written to the stream.
|
|
|
217
|
|
|
218 -- Verify the information of the first product.
|
|
|
219 if ((Product_01 /= TC_Product1) or else
|
|
|
220 (Product_01.Manufacture /= TC_Product1.Manufacture) or else
|
|
|
221 (Sale_Count_01 /= TC_Count1) or else
|
|
|
222 (Sale_Rec_01 /= TC_Rec1(1)) or else
|
|
|
223 (Sale_Rec_01.Buyer /= TC_Rec1(1).Buyer) or else
|
|
|
224 (Sale_Rec_02 /= TC_Rec1(2)) or else
|
|
|
225 (Sale_Rec_02.Buyer /= TC_Rec1(2).Buyer) or else
|
|
|
226 (Product_01_Stats /= TC_Stat1))
|
|
|
227 then
|
|
|
228 Report.Failed ("Product 1 information incorrect");
|
|
|
229 end if;
|
|
|
230
|
|
|
231 -- Verify the information of the second product.
|
|
|
232 if not ((Product_02 = TC_Product2) and then
|
|
|
233 (Sale_Count_02 = TC_Count2) and then
|
|
|
234 (Product_02_Stats = TC_Stat2))
|
|
|
235 then
|
|
|
236 Report.Failed ("Product 2 information incorrect");
|
|
|
237 end if;
|
|
|
238
|
|
|
239 -- Verify the information of the third product.
|
|
|
240 if ((Product_03 /= TC_Product3) or else
|
|
|
241 (Product_03.Manufacture /= TC_Product3.Manufacture) or else
|
|
|
242 (Sale_Count_03 /= TC_Count3) or else
|
|
|
243 (Sale_Rec_03 /= TC_Rec3(1)) or else
|
|
|
244 (Sale_Rec_03.Buyer /= TC_Rec3(1).Buyer) or else
|
|
|
245 (Sale_Rec_04 /= TC_Rec3(2)) or else
|
|
|
246 (Sale_Rec_04.Buyer /= TC_Rec3(2).Buyer) or else
|
|
|
247 (Sale_Rec_05 /= TC_Rec3(3)) or else
|
|
|
248 (Sale_Rec_05.Buyer /= TC_Rec3(3).Buyer) or else
|
|
|
249 (Product_03_Stats /= TC_Stat3))
|
|
|
250 then
|
|
|
251 Report.Failed ("Product 3 information incorrect");
|
|
|
252 end if;
|
|
|
253
|
|
|
254 end Verify_Data_Block;
|
|
|
255
|
|
|
256 exception
|
|
|
257
|
|
|
258 when others =>
|
|
|
259 Report.Failed ("Exception raised in Operational Test Block");
|
|
|
260
|
|
|
261 end Operational_Test_Block;
|
|
|
262
|
|
|
263 if Ada.Streams.Stream_IO.Is_Open (Info_File) then
|
|
|
264 Ada.Streams.Stream_IO.Delete (Info_File);
|
|
|
265 else
|
|
|
266 Ada.Streams.Stream_IO.Open (Info_File,
|
|
|
267 Ada.Streams.Stream_IO.In_File,
|
|
|
268 The_Filename);
|
|
|
269 Ada.Streams.Stream_IO.Delete (Info_File);
|
|
|
270 end if;
|
|
|
271
|
|
|
272 exception
|
|
|
273
|
|
|
274 -- Since Use_Error or Name_Error can be raised if, for the specified
|
|
|
275 -- mode, the environment does not support Stream_IO operations,
|
|
|
276 -- the following handlers are included:
|
|
|
277
|
|
|
278 when Ada.Streams.Stream_IO.Name_Error =>
|
|
|
279 Report.Not_Applicable ("Name_Error raised on Stream IO Create");
|
|
|
280
|
|
|
281 when Ada.Streams.Stream_IO.Use_Error =>
|
|
|
282 Report.Not_Applicable ("Use_Error raised on Stream IO Create");
|
|
|
283
|
|
|
284 when others =>
|
|
|
285 Report.Failed ("Unexpected exception raised on Stream IO Create");
|
|
|
286
|
|
|
287 end Test_for_Stream_IO_Support;
|
|
|
288
|
|
|
289 Report.Result;
|
|
|
290
|
|
|
291 end CXACA01;
|
