|
111
|
1 -- CXACC01.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 use of 'Class'Output and 'Class'Input allow stream
|
|
|
28 -- manipulation of objects of non-limited class-wide types.
|
|
|
29 --
|
|
|
30 -- TEST DESCRIPTION:
|
|
|
31 -- This test demonstrates the uses of 'Class'Output and 'Class'Input
|
|
|
32 -- in moving objects of a particular class to and from a stream file.
|
|
|
33 -- A procedure uses a class-wide parameter to move objects of specific
|
|
|
34 -- types in the class to the stream, using the 'Class'Output attribute
|
|
|
35 -- of the root type of the class. A function returns a class-wide object,
|
|
|
36 -- using the 'Class'Input attribute of the root type of the class to
|
|
|
37 -- extract the object from the stream.
|
|
|
38 -- A field-by-field comparison of record objects is performed to validate
|
|
|
39 -- the data read from the stream. Operator precedence rules are used
|
|
|
40 -- in the comparison rather than parentheses.
|
|
|
41 --
|
|
|
42 -- APPLICABILITY CRITERIA:
|
|
|
43 -- This test is applicable to all implementations capable of supporting
|
|
|
44 -- external Stream_IO files.
|
|
|
45 --
|
|
|
46 --
|
|
|
47 -- CHANGE HISTORY:
|
|
|
48 -- 06 Dec 94 SAIC ACVC 2.0
|
|
|
49 -- 14 Nov 95 SAIC Corrected prefix of 'Tag attribute for ACVC 2.0.1.
|
|
|
50 -- 24 Aug 96 SAIC Changed a call to "Create" to "Reset".
|
|
|
51 -- 26 Feb 97 CTA.PWB Allowed for non-support of some IO operations.
|
|
|
52 --!
|
|
|
53
|
|
|
54 with FXACC00, Ada.Streams.Stream_IO, Ada.Tags, Report;
|
|
|
55
|
|
|
56 procedure CXACC01 is
|
|
|
57
|
|
|
58 Order_File : Ada.Streams.Stream_IO.File_Type;
|
|
|
59 Order_Stream : Ada.Streams.Stream_IO.Stream_Access;
|
|
|
60 Order_Filename : constant String :=
|
|
|
61 Report.Legal_File_Name ( Nam => "CXACC01" );
|
|
|
62 Incomplete : exception;
|
|
|
63
|
|
|
64 begin
|
|
|
65
|
|
|
66 Report.Test ("CXACC01", "Check that the use of 'Class'Output " &
|
|
|
67 "and 'Class'Input allow stream manipulation " &
|
|
|
68 "of objects of non-limited class-wide types");
|
|
|
69
|
|
|
70 Test_for_Stream_IO_Support:
|
|
|
71 begin
|
|
|
72
|
|
|
73 -- If an implementation does not support Stream_IO in a particular
|
|
|
74 -- environment, the exception Use_Error or Name_Error will be raised on
|
|
|
75 -- calls to various Stream_IO operations. This block statement
|
|
|
76 -- encloses a call to Create, which should produce an exception in a
|
|
|
77 -- non-supportive environment. These exceptions will be handled to
|
|
|
78 -- produce a Not_Applicable result.
|
|
|
79
|
|
|
80 Ada.Streams.Stream_IO.Create (Order_File,
|
|
|
81 Ada.Streams.Stream_IO.Out_File,
|
|
|
82 Order_Filename);
|
|
|
83
|
|
|
84 exception
|
|
|
85
|
|
|
86 when Ada.Streams.Stream_IO.Use_Error | Ada.Streams.Stream_IO.Name_Error =>
|
|
|
87 Report.Not_Applicable
|
|
|
88 ( "Files not supported - Create as Out_File for Stream_IO" );
|
|
|
89 raise Incomplete;
|
|
|
90
|
|
|
91 end Test_for_Stream_IO_Support;
|
|
|
92
|
|
|
93 Operational_Test_Block:
|
|
|
94 declare
|
|
|
95
|
|
|
96 -- Store tag values associated with objects of tagged types.
|
|
|
97
|
|
|
98 TC_Box_Office_Tag : constant String :=
|
|
|
99 Ada.Tags.External_Tag(FXACC00.Ticket_Request'Tag);
|
|
|
100
|
|
|
101 TC_Summer_Tag : constant String :=
|
|
|
102 Ada.Tags.External_Tag(FXACC00.Subscriber_Request'Tag);
|
|
|
103
|
|
|
104 TC_Mayoral_Tag : constant String :=
|
|
|
105 Ada.Tags.External_Tag(FXACC00.VIP_Request'Tag);
|
|
|
106
|
|
|
107 TC_Late_Tag : constant String :=
|
|
|
108 Ada.Tags.External_Tag(FXACC00.Last_Minute_Request'Tag);
|
|
|
109
|
|
|
110 -- The following procedure will take an object of the Ticket_Request
|
|
|
111 -- class and output it to the stream. Objects of any extended type
|
|
|
112 -- in the class can be output to the stream with this procedure.
|
|
|
113
|
|
|
114 procedure Order_Entry (Order : FXACC00.Ticket_Request'Class) is
|
|
|
115 begin
|
|
|
116 FXACC00.Ticket_Request'Class'Output (Order_Stream, Order);
|
|
|
117 end Order_Entry;
|
|
|
118
|
|
|
119
|
|
|
120 -- The following function will retrieve from the stream an object of
|
|
|
121 -- the Ticket_Request class.
|
|
|
122
|
|
|
123 function Order_Retrieval return FXACC00.Ticket_Request'Class is
|
|
|
124 begin
|
|
|
125 return FXACC00.Ticket_Request'Class'Input (Order_Stream);
|
|
|
126 end Order_Retrieval;
|
|
|
127
|
|
|
128 begin
|
|
|
129
|
|
|
130 Order_Stream := Ada.Streams.Stream_IO.Stream (Order_File);
|
|
|
131
|
|
|
132 -- Store the data objects in the stream.
|
|
|
133 -- Each of the objects is of a different type within the class.
|
|
|
134
|
|
|
135 Order_Entry (FXACC00.Box_Office_Request); -- Object of root type
|
|
|
136 Order_Entry (FXACC00.Summer_Subscription); -- Obj. of extended type
|
|
|
137 Order_Entry (FXACC00.Mayoral_Ticket_Request); -- Obj. of extended type
|
|
|
138 Order_Entry (FXACC00.Late_Request); -- Object of twice
|
|
|
139 -- extended type.
|
|
|
140
|
|
|
141 -- Reset mode of stream to In_File prior to reading data from it.
|
|
|
142 Reset1:
|
|
|
143 begin
|
|
|
144 Ada.Streams.Stream_IO.Reset (Order_File,
|
|
|
145 Ada.Streams.Stream_IO.In_File);
|
|
|
146 exception
|
|
|
147 when Ada.Streams.Stream_IO.Use_Error =>
|
|
|
148 Report.Not_Applicable
|
|
|
149 ( "Reset to In_File not supported for Stream_IO - 1" );
|
|
|
150 raise Incomplete;
|
|
|
151 end Reset1;
|
|
|
152
|
|
|
153 Process_Order_Block:
|
|
|
154 declare
|
|
|
155
|
|
|
156 use FXACC00;
|
|
|
157
|
|
|
158 -- Declare variables of the root type class,
|
|
|
159 -- and initialize them with class-wide objects returned from
|
|
|
160 -- the stream as function result.
|
|
|
161
|
|
|
162 Order_1 : Ticket_Request'Class := Order_Retrieval;
|
|
|
163 Order_2 : Ticket_Request'Class := Order_Retrieval;
|
|
|
164 Order_3 : Ticket_Request'Class := Order_Retrieval;
|
|
|
165 Order_4 : Ticket_Request'Class := Order_Retrieval;
|
|
|
166
|
|
|
167 -- Declare objects of the specific types from within the class
|
|
|
168 -- that correspond to the types of the data written to the
|
|
|
169 -- stream. Perform a type conversion on the class-wide objects.
|
|
|
170
|
|
|
171 Ticket_Order : Ticket_Request :=
|
|
|
172 Ticket_Request(Order_1);
|
|
|
173 Subscriber_Order : Subscriber_Request :=
|
|
|
174 Subscriber_Request(Order_2);
|
|
|
175 VIP_Order : VIP_Request :=
|
|
|
176 VIP_Request(Order_3);
|
|
|
177 Last_Minute_Order : Last_Minute_Request :=
|
|
|
178 Last_Minute_Request(Order_4);
|
|
|
179
|
|
|
180 begin
|
|
|
181
|
|
|
182 -- Perform a field-by-field comparison of all the class-wide
|
|
|
183 -- objects input from the stream with specific type objects
|
|
|
184 -- originally written to the stream.
|
|
|
185
|
|
|
186 if Ticket_Order.Location /=
|
|
|
187 Box_Office_Request.Location or
|
|
|
188 Ticket_Order.Number_Of_Tickets /=
|
|
|
189 Box_Office_Request.Number_Of_Tickets
|
|
|
190 then
|
|
|
191 Report.Failed ("Ticket_Request object validation failure");
|
|
|
192 end if;
|
|
|
193
|
|
|
194 if Subscriber_Order.Location /=
|
|
|
195 Summer_Subscription.Location or
|
|
|
196 Subscriber_Order.Number_Of_Tickets /=
|
|
|
197 Summer_Subscription.Number_Of_Tickets or
|
|
|
198 Subscriber_Order.Subscription_Number /=
|
|
|
199 Summer_Subscription.Subscription_Number
|
|
|
200 then
|
|
|
201 Report.Failed ("Subscriber_Request object validation failure");
|
|
|
202 end if;
|
|
|
203
|
|
|
204 if VIP_Order.Location /=
|
|
|
205 Mayoral_Ticket_Request.Location or
|
|
|
206 VIP_Order.Number_Of_Tickets /=
|
|
|
207 Mayoral_Ticket_Request.Number_Of_Tickets or
|
|
|
208 VIP_Order.Rank /=
|
|
|
209 Mayoral_Ticket_Request.Rank
|
|
|
210 then
|
|
|
211 Report.Failed ("VIP_Request object validation failure");
|
|
|
212 end if;
|
|
|
213
|
|
|
214 if Last_Minute_Order.Location /=
|
|
|
215 Late_Request.Location or
|
|
|
216 Last_Minute_Order.Number_Of_Tickets /=
|
|
|
217 Late_Request.Number_Of_Tickets or
|
|
|
218 Last_Minute_Order.Rank /=
|
|
|
219 Late_Request.Rank or
|
|
|
220 Last_Minute_Order.Special_Consideration /=
|
|
|
221 Late_Request.Special_Consideration or
|
|
|
222 Last_Minute_Order.Donation /=
|
|
|
223 Late_Request.Donation
|
|
|
224 then
|
|
|
225 Report.Failed ("Last_Minute_Request object validation failure");
|
|
|
226 end if;
|
|
|
227
|
|
|
228 -- Verify tag values from before and after processing.
|
|
|
229 -- The 'Tag attribute is used with objects of a class-wide type.
|
|
|
230
|
|
|
231 if TC_Box_Office_Tag /=
|
|
|
232 Ada.Tags.External_Tag(Order_1'Tag)
|
|
|
233 then
|
|
|
234 Report.Failed("Failed tag comparison - 1");
|
|
|
235 end if;
|
|
|
236
|
|
|
237 if TC_Summer_Tag /=
|
|
|
238 Ada.Tags.External_Tag(Order_2'Tag)
|
|
|
239 then
|
|
|
240 Report.Failed("Failed tag comparison - 2");
|
|
|
241 end if;
|
|
|
242
|
|
|
243 if TC_Mayoral_Tag /=
|
|
|
244 Ada.Tags.External_Tag(Order_3'Tag)
|
|
|
245 then
|
|
|
246 Report.Failed("Failed tag comparison - 3");
|
|
|
247 end if;
|
|
|
248
|
|
|
249 if TC_Late_Tag /=
|
|
|
250 Ada.Tags.External_Tag(Order_4'Tag)
|
|
|
251 then
|
|
|
252 Report.Failed("Failed tag comparison - 4");
|
|
|
253 end if;
|
|
|
254
|
|
|
255 end Process_Order_Block;
|
|
|
256
|
|
|
257 -- After all the data has been correctly extracted, the file
|
|
|
258 -- should be empty.
|
|
|
259
|
|
|
260 if not Ada.Streams.Stream_IO.End_Of_File (Order_File) then
|
|
|
261 Report.Failed ("Stream file not empty");
|
|
|
262 end if;
|
|
|
263
|
|
|
264 exception
|
|
|
265 when Incomplete =>
|
|
|
266 raise;
|
|
|
267 when Constraint_Error =>
|
|
|
268 Report.Failed ("Constraint_Error raised in Operational Block");
|
|
|
269 when others =>
|
|
|
270 Report.Failed ("Exception raised in Operational Test Block");
|
|
|
271 end Operational_Test_Block;
|
|
|
272
|
|
|
273 Deletion:
|
|
|
274 begin
|
|
|
275 if Ada.Streams.Stream_IO.Is_Open (Order_File) then
|
|
|
276 Ada.Streams.Stream_IO.Delete (Order_File);
|
|
|
277 else
|
|
|
278 Ada.Streams.Stream_IO.Open (Order_File,
|
|
|
279 Ada.Streams.Stream_IO.Out_File,
|
|
|
280 Order_Filename);
|
|
|
281 Ada.Streams.Stream_IO.Delete (Order_File);
|
|
|
282 end if;
|
|
|
283 exception
|
|
|
284 when others =>
|
|
|
285 Report.Failed
|
|
|
286 ( "Delete not properly implemented for Stream_IO" );
|
|
|
287 end Deletion;
|
|
|
288
|
|
|
289 Report.Result;
|
|
|
290
|
|
|
291 exception
|
|
|
292
|
|
|
293 when Incomplete =>
|
|
|
294 Report.Result;
|
|
|
295 when others =>
|
|
|
296 Report.Failed ( "Unexpected exception" );
|
|
|
297 Report.Result;
|
|
|
298
|
|
|
299 end CXACC01;
|
