Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxa/cxaca01.a @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
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;