3 -- Grant of Unlimited Rights
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
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.
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.
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.
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.
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
55 -- APPLICABILITY CRITERIA:
56 -- Applicable to all implementations that support external
61 -- 06 Dec 94 SAIC ACVC 2.0
66 with Ada
.Streams
.Stream_IO
;
73 Report
.Test
("CXACA01", "Check that 'Write and 'Read work properly " &
74 "when used with complex data types");
76 Test_for_Stream_IO_Support
:
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
;
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.
92 Ada
.Streams
.Stream_IO
.Create
(Info_File
,
93 Ada
.Streams
.Stream_IO
.Out_File
,
96 Operational_Test_Block
:
101 Info_Stream
:= Ada
.Streams
.Stream_IO
.Stream
(Info_File
);
103 -- Write all of the product information (record, integer, and array
104 -- objects) defined in package FXACA00 into the stream.
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
);
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
);
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
);
133 end Store_Data_Block
;
139 use FXACA00
; -- Used within this block only.
141 type Domestic_Rec_Array_Type
is
142 array (Positive range <>) of Sales_Record_Type
(Domestic
);
144 type Foreign_Rec_Array_Type
is
145 array (Positive range <>) of Sales_Record_Type
(Foreign
);
147 TC_Rec1
: Domestic_Rec_Array_Type
(1..2);
148 TC_Rec3
: Foreign_Rec_Array_Type
(1..3);
150 TC_Product1
: Product_Type
;
152 TC_Product3
: Product_Type
(Foreign
);
156 TC_Count3
: Integer := -10; -- Initialized to dummy value.
160 TC_Stat3
: Sales_Statistics_Type
:= (others => 500);
164 Ada
.Streams
.Stream_IO
.Reset
(Info_File
,
165 Ada
.Streams
.Stream_IO
.In_File
);
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
176 -- Extract data on first product.
177 Product_Type
'Read (Info_Stream
, TC_Product1
);
178 Integer'Read (Info_Stream
, TC_Count1
);
180 -- Two "domestic" variant sales records will be read from the
182 for i
in 1 .. TC_Count1
loop
183 Sales_Record_Type
'Read (Info_Stream
, TC_Rec1
(i
) );
186 Sales_Statistics_Type
'Read (Info_Stream
, TC_Stat1
);
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
);
195 -- Extract data on third product.
196 Product_Type
'Read (Info_Stream
, TC_Product3
);
197 Integer'Read (Info_Stream
, TC_Count3
);
199 -- Three "foreign" variant sales records will be read from the
201 for i
in 1 .. TC_Count3
loop
202 Sales_Record_Type
'Read (Info_Stream
, TC_Rec3
(i
) );
205 Sales_Statistics_Type
'Read (Info_Stream
, TC_Stat3
);
208 -- After all the data has been correctly extracted, the file
211 if not Ada
.Streams
.Stream_IO
.End_Of_File
(Info_File
) then
212 Report
.Failed
("Stream file not empty");
215 -- Verify that the data values read from the stream are the same
216 -- as those written to the stream.
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
))
228 Report
.Failed
("Product 1 information incorrect");
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
))
236 Report
.Failed
("Product 2 information incorrect");
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
))
251 Report
.Failed
("Product 3 information incorrect");
254 end Verify_Data_Block
;
259 Report
.Failed
("Exception raised in Operational Test Block");
261 end Operational_Test_Block
;
263 if Ada
.Streams
.Stream_IO
.Is_Open
(Info_File
) then
264 Ada
.Streams
.Stream_IO
.Delete
(Info_File
);
266 Ada
.Streams
.Stream_IO
.Open
(Info_File
,
267 Ada
.Streams
.Stream_IO
.In_File
,
269 Ada
.Streams
.Stream_IO
.Delete
(Info_File
);
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:
278 when Ada
.Streams
.Stream_IO
.Name_Error
=>
279 Report
.Not_Applicable
("Name_Error raised on Stream IO Create");
281 when Ada
.Streams
.Stream_IO
.Use_Error
=>
282 Report
.Not_Applicable
("Use_Error raised on Stream IO Create");
285 Report
.Failed
("Unexpected exception raised on Stream IO Create");
287 end Test_for_Stream_IO_Support
;