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 attribute T'Write will, for any specific non-limited
28 -- type T, write an item of the subtype to the stream.
30 -- Check that the attribute T'Read will, for a specific non-limited
31 -- type T, read a value of the subtype from the stream.
34 -- The scenario depicted in this test is that of an environment where
35 -- product data is stored in stream form, then reconstructed into the
36 -- appropriate data structures. Several records of product information
37 -- are stored in an array; the array is passed as a parameter to a
38 -- procedure for storage in the stream. A header is created based on the
39 -- number of data records stored in the array. The header is then written
40 -- to the stream, followed by each record maintained in the array.
41 -- In order to retrieve data from the stream, the header information is
42 -- read from the stream, and the data stored in the header is used to
43 -- perform the appropriate number of read operations of record data from
44 -- the stream. All data read from the stream is validated against the
45 --- values that were written to the stream.
47 -- APPLICABILITY CRITERIA:
48 -- Applicable to all systems capable of supporting IO operations on
49 -- external Stream_IO files.
53 -- 06 Dec 94 SAIC ACVC 2.0
54 -- 08 Nov 95 SAIC Corrected call to Read in Procedure Retrieve_Data
56 -- 27 Feb 08 PWB.CTA Allowed for non-support of certain IO operations.
59 with Ada
.Streams
.Stream_IO
;
64 package Strm_Pack
renames Ada
.Streams
.Stream_IO
;
65 The_File
: Strm_Pack
.File_Type
;
66 The_Filename
: constant String :=
67 Report
.Legal_File_Name
( Nam
=> "CXAC001" );
68 Incomplete
: exception;
73 Report
.Test
("CXAC001", "Check that the 'Read and 'Write attributes " &
74 "will transfer an object of a specific, " &
75 "non-limited type to/from a stream");
77 Test_for_Stream_IO_Support
:
80 -- If an implementation does not support Stream_IO in a particular
81 -- environment, the exception Use_Error or Name_Error will be raised on
82 -- calls to various Stream_IO operations. This block statement
83 -- encloses a call to Create, which should produce an exception in a
84 -- non-supportive environment. These exceptions will be handled to
85 -- produce a Not_Applicable result.
87 Strm_Pack
.Create
(The_File
, Strm_Pack
.Out_File
, The_Filename
);
91 when Ada
.Streams
.Stream_IO
.Use_Error |
92 Ada
.Streams
.Stream_IO
.Name_Error
=>
94 ( "Files not supported - Create as Out_File for Stream_IO" );
97 end Test_for_Stream_IO_Support
;
99 Operational_Test_Block
:
102 The_Stream
: Strm_Pack
.Stream_Access
;
103 Todays_Date
: String (1 .. 6) := "271193";
105 type ID_Type
is range 1 .. 100;
106 type Size_Type
is (Small
, Medium
, Large
, XLarge
);
108 type Header_Type
is record
109 Number_of_Elements
: Natural := 0;
110 Origination_Date
: String (1 .. 6);
113 type Data_Type
is record
118 type Data_Array_Type
is array (Positive range <>) of Data_Type
;
120 Product_Information_1
: Data_Array_Type
(1 .. 3) := ((20, Large
),
124 Product_Information_2
: Data_Array_Type
(1 .. 4) := (( 5, XLarge
),
129 procedure Store_Data
( The_Stream
: in Strm_Pack
.Stream_Access
;
130 The_Array
: in Data_Array_Type
) is
131 Header
: Header_Type
;
134 -- Fill in header info.
135 Header
.Number_of_Elements
:= The_Array
'Length;
136 Header
.Origination_Date
:= Todays_Date
;
138 -- Write header to stream.
139 Header_Type
'Write (The_Stream
, Header
);
141 -- Write each record in the array to the stream.
142 for I
in 1 .. Header
.Number_of_Elements
loop
143 Data_Type
'Write (The_Stream
, The_Array
(I
));
148 procedure Retrieve_Data
(The_Stream
: in Strm_Pack
.Stream_Access
;
149 The_Header
: out Header_Type
;
150 The_Array
: out Data_Array_Type
) is
153 -- Read header from the stream.
154 Header_Type
'Read (The_Stream
, The_Header
);
156 -- Read the records from the stream into the array.
157 for I
in 1 .. The_Header
.Number_of_Elements
loop
158 Data_Type
'Read (The_Stream
, The_Array
(I
));
165 -- Assign access value.
166 The_Stream
:= Strm_Pack
.Stream
(The_File
);
168 -- Product information is to be stored in the stream file. These
169 -- data arrays are of different sizes (actually, the records
170 -- are stored individually, not as a single array). Prior to the
171 -- record data being written, a header record is initialized with
172 -- information about the data to be written, then itself is written
175 Store_Data
(The_Stream
, Product_Information_1
);
176 Store_Data
(The_Stream
, Product_Information_2
);
178 Test_Verification_Block
:
180 Product_Header_1
: Header_Type
;
181 Product_Header_2
: Header_Type
;
182 Product_Array_1
: Data_Array_Type
(1 .. 3);
183 Product_Array_2
: Data_Array_Type
(1 .. 4);
188 Strm_Pack
.Reset
(The_File
, Strm_Pack
.In_File
);
190 when Ada
.Streams
.Stream_IO
.Use_Error
=>
191 Report
.Not_Applicable
192 ( "Reset to In_File not supported for Stream_IO" );
196 -- Data is read from the stream, first the appropriate header,
197 -- then the associated data records, which are then reconstructed
198 -- into a data array of product information.
200 Retrieve_Data
(The_Stream
, Product_Header_1
, Product_Array_1
);
202 -- Validate a field in the header.
203 if (Product_Header_1
.Origination_Date
/= Todays_Date
) or
204 (Product_Header_1
.Number_of_Elements
/= 3)
206 Report
.Failed
("Incorrect Header_1 info read from stream");
209 -- Validate the data records read from the file.
210 for I
in 1 .. Product_Header_1
.Number_of_Elements
loop
211 if (Product_Array_1
(I
) /= Product_Information_1
(I
)) then
212 Report
.Failed
("Incorrect Product 1 info read from" &
213 " record: " & Integer'Image (I
));
217 -- Repeat this read and verify operation for the next parcel of
218 -- data. Again, header and data record information are read from
219 -- the same stream file.
220 Retrieve_Data
(The_Stream
, Product_Header_2
, Product_Array_2
);
222 if (Product_Header_2
.Origination_Date
/= Todays_Date
) or
223 (Product_Header_2
.Number_of_Elements
/= 4)
225 Report
.Failed
("Incorrect Header_2 info read from stream");
228 for I
in 1 .. Product_Header_2
.Number_of_Elements
loop
229 if (Product_Array_2
(I
) /= Product_Information_2
(I
)) then
230 Report
.Failed
("Incorrect Product_2 info read from" &
231 " record: " & Integer'Image (I
));
240 when Strm_Pack
.End_Error
=> -- If correct number of
241 -- items not in file (data
242 -- overwritten), then fail.
243 Report
.Failed
("Incorrect number of record elements in file");
244 if not Strm_Pack
.Is_Open
(The_File
) then
245 Strm_Pack
.Open
(The_File
, Strm_Pack
.Out_File
, The_Filename
);
249 Report
.Failed
("Exception raised in Data Verification Block");
250 if not Strm_Pack
.Is_Open
(The_File
) then
251 Strm_Pack
.Open
(The_File
, Strm_Pack
.Out_File
, The_Filename
);
254 end Test_Verification_Block
;
262 Report
.Failed
("Exception raised in Operational Test Block");
264 end Operational_Test_Block
;
269 if Strm_Pack
.Is_Open
(The_File
) then
270 Strm_Pack
.Delete
(The_File
);
272 Strm_Pack
.Open
(The_File
, Strm_Pack
.Out_File
, The_Filename
);
273 Strm_Pack
.Delete
(The_File
);
280 ( "Delete not properly implemented for Stream_IO" );
289 Report
.Failed
( "Unexpected exception" );