|
111
|
1 -- CXAA016.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 type File_Access is available in Ada.Text_IO, and that
|
|
|
28 -- objects of this type designate File_Type objects.
|
|
|
29 -- Check that function Set_Error will set the current default error file.
|
|
|
30 -- Check that versions of Ada.Text_IO functions Standard_Input,
|
|
|
31 -- Standard_Output, Standard_Error return File_Access values designating
|
|
|
32 -- the standard system input, output, and error files.
|
|
|
33 -- Check that versions of Ada.Text_IO functions Current_Input,
|
|
|
34 -- Current_Output, Current_Error return File_Access values designating
|
|
|
35 -- the current system input, output, and error files.
|
|
|
36 --
|
|
|
37 -- TEST DESCRIPTION:
|
|
|
38 -- This test tests the use of File_Access objects in referring
|
|
|
39 -- to File_Type objects, as well as several new functions that return
|
|
|
40 -- File_Access objects as results.
|
|
|
41 -- Four user-defined files are created. These files will be set to
|
|
|
42 -- function as current system input, output, and error files.
|
|
|
43 -- Data will be read from and written to these files during the
|
|
|
44 -- time at which they function as the current system files.
|
|
|
45 -- An array of File_Access objects will be defined. It will be
|
|
|
46 -- initialized using functions that return File_Access objects
|
|
|
47 -- referencing the Standard and Current Input, Output, and Error files.
|
|
|
48 -- This "saves" the initial system environment, which will be modified
|
|
|
49 -- to use the user-defined files as the current default Input, Output,
|
|
|
50 -- and Error files. At the end of the test, the data in this array
|
|
|
51 -- will be used to restore the initial system environment.
|
|
|
52 --
|
|
|
53 -- APPLICABILITY CRITERIA:
|
|
|
54 -- This test is applicable to implementations capable of supporting
|
|
|
55 -- external Text_IO files.
|
|
|
56 --
|
|
|
57 --
|
|
|
58 -- CHANGE HISTORY:
|
|
|
59 -- 25 May 95 SAIC Initial prerelease version.
|
|
|
60 -- 22 Apr 96 SAIC Incorporated reviewer comments for ACVC 2.1.
|
|
|
61 -- 26 Feb 97 PWB.CTA Allowed for non-support of some IO operations.
|
|
|
62 -- 18 Jan 99 RLB Repaired to allow Not_Applicable systems to
|
|
|
63 -- fail delete.
|
|
|
64 --!
|
|
|
65
|
|
|
66 with Ada.Text_IO;
|
|
|
67 package CXAA016_0 is
|
|
|
68 New_Input_File,
|
|
|
69 New_Output_File,
|
|
|
70 New_Error_File_1,
|
|
|
71 New_Error_File_2 : aliased Ada.Text_IO.File_Type;
|
|
|
72 end CXAA016_0;
|
|
|
73
|
|
|
74
|
|
|
75 with Report;
|
|
|
76 with Ada.Exceptions;
|
|
|
77 with Ada.Text_IO; use Ada.Text_IO;
|
|
|
78 with CXAA016_0; use CXAA016_0;
|
|
|
79
|
|
|
80 procedure CXAA016 is
|
|
|
81
|
|
|
82 Non_Applicable_System : exception;
|
|
|
83 No_Reset : exception;
|
|
|
84 Not_Applicable_System : Boolean := False;
|
|
|
85
|
|
|
86 procedure Delete_File ( A_File : in out Ada.Text_IO.File_Type;
|
|
|
87 ID_Num : in Integer ) is
|
|
|
88 begin
|
|
|
89 if not Ada.Text_IO.Is_Open ( A_File ) then
|
|
|
90 Ada.Text_IO.Open ( A_File,
|
|
|
91 Ada.Text_IO.In_File,
|
|
|
92 Report.Legal_File_Name ( ID_Num ) );
|
|
|
93 end if;
|
|
|
94 Ada.Text_IO.Delete ( A_File );
|
|
|
95 exception
|
|
|
96 when Ada.Text_IO.Name_Error =>
|
|
|
97 if Not_Applicable_System then
|
|
|
98 null; -- File probably wasn't created.
|
|
|
99 else
|
|
|
100 Report.Failed ( "Can't open file for Text_IO" );
|
|
|
101 end if;
|
|
|
102 when Ada.Text_IO.Use_Error =>
|
|
|
103 if Not_Applicable_System then
|
|
|
104 null; -- File probably wasn't created.
|
|
|
105 else
|
|
|
106 Report.Failed ( "Delete not properly implemented for Text_IO" );
|
|
|
107 end if;
|
|
|
108 when others =>
|
|
|
109 Report.Failed ( "Unexpected exception in Delete_File" );
|
|
|
110 end Delete_File;
|
|
|
111
|
|
|
112 begin
|
|
|
113
|
|
|
114 Report.Test ("CXAA016", "Check that the type File_Access is available " &
|
|
|
115 "in Ada.Text_IO, and that objects of this " &
|
|
|
116 "type designate File_Type objects");
|
|
|
117 Test_Block:
|
|
|
118 declare
|
|
|
119
|
|
|
120 use Ada.Exceptions;
|
|
|
121
|
|
|
122 type System_File_Array_Type is
|
|
|
123 array (Integer range <>) of File_Access;
|
|
|
124
|
|
|
125 -- Fill the following array with the File_Access results of six
|
|
|
126 -- functions.
|
|
|
127
|
|
|
128 Initial_Environment : System_File_Array_Type(1..6) :=
|
|
|
129 ( Standard_Input,
|
|
|
130 Standard_Output,
|
|
|
131 Standard_Error,
|
|
|
132 Current_Input,
|
|
|
133 Current_Output,
|
|
|
134 Current_Error );
|
|
|
135
|
|
|
136 New_Input_Ptr : File_Access := New_Input_File'Access;
|
|
|
137 New_Output_Ptr : File_Access := New_Output_File'Access;
|
|
|
138 New_Error_Ptr : File_Access := New_Error_File_1'Access;
|
|
|
139
|
|
|
140 Line : String(1..80);
|
|
|
141 Length : Natural := 0;
|
|
|
142
|
|
|
143 Line_1 : constant String := "This is the first line in the Output file";
|
|
|
144 Line_2 : constant String := "This is the next line in the Output file";
|
|
|
145 Line_3 : constant String := "This is the first line in Error file 1";
|
|
|
146 Line_4 : constant String := "This is the next line in Error file 1";
|
|
|
147 Line_5 : constant String := "This is the first line in Error file 2";
|
|
|
148 Line_6 : constant String := "This is the next line in Error file 2";
|
|
|
149
|
|
|
150
|
|
|
151
|
|
|
152 procedure New_File (The_File : in out File_Type;
|
|
|
153 Mode : in File_Mode;
|
|
|
154 Next : in Integer) is
|
|
|
155 begin
|
|
|
156 Create (The_File, Mode, Report.Legal_File_Name(Next));
|
|
|
157 exception
|
|
|
158 -- The following two exceptions may be raised if a system is not
|
|
|
159 -- capable of supporting external Text_IO files. The handler will
|
|
|
160 -- raise a user-defined exception which will result in a
|
|
|
161 -- Not_Applicable result for the test.
|
|
|
162 when Use_Error | Name_Error => raise Non_Applicable_System;
|
|
|
163 end New_File;
|
|
|
164
|
|
|
165
|
|
|
166
|
|
|
167 procedure Check_Initial_Environment (Env : System_File_Array_Type) is
|
|
|
168 begin
|
|
|
169 -- Check that the system has defined the following sources/
|
|
|
170 -- destinations for input/output/error, and that the six functions
|
|
|
171 -- returning File_Access values are available.
|
|
|
172 if not (Env(1) = Standard_Input and
|
|
|
173 Env(2) = Standard_Output and
|
|
|
174 Env(3) = Standard_Error and
|
|
|
175 Env(4) = Current_Input and
|
|
|
176 Env(5) = Current_Output and
|
|
|
177 Env(6) = Current_Error)
|
|
|
178 then
|
|
|
179 Report.Failed("At the start of the test, the Standard and " &
|
|
|
180 "Current File_Access values associated with " &
|
|
|
181 "system Input, Output, and Error files do " &
|
|
|
182 "not correspond");
|
|
|
183 end if;
|
|
|
184 end Check_Initial_Environment;
|
|
|
185
|
|
|
186
|
|
|
187
|
|
|
188 procedure Load_Input_File (Input_Ptr : in File_Access) is
|
|
|
189 begin
|
|
|
190 -- Load data into the file that will function as the user-defined
|
|
|
191 -- system input file.
|
|
|
192 Put_Line(Input_Ptr.all, Line_1);
|
|
|
193 Put_Line(Input_Ptr.all, Line_2);
|
|
|
194 Put_Line(Input_Ptr.all, Line_3);
|
|
|
195 Put_Line(Input_Ptr.all, Line_4);
|
|
|
196 Put_Line(Input_Ptr.all, Line_5);
|
|
|
197 Put_Line(Input_Ptr.all, Line_6);
|
|
|
198 end Load_Input_File;
|
|
|
199
|
|
|
200
|
|
|
201
|
|
|
202 procedure Restore_Initial_Environment
|
|
|
203 (Initial_Env : System_File_Array_Type) is
|
|
|
204 begin
|
|
|
205 -- Restore the Current Input, Output, and Error files to their
|
|
|
206 -- original states.
|
|
|
207
|
|
|
208 Set_Input (Initial_Env(4).all);
|
|
|
209 Set_Output(Initial_Env(5).all);
|
|
|
210 Set_Error (Initial_Env(6).all);
|
|
|
211
|
|
|
212 -- At this point, the user-defined files that were functioning as
|
|
|
213 -- the Current Input, Output, and Error files have been replaced in
|
|
|
214 -- that capacity by the state of the original environment.
|
|
|
215
|
|
|
216 declare
|
|
|
217
|
|
|
218 -- Capture the state of the current environment.
|
|
|
219
|
|
|
220 Current_Env : System_File_Array_Type (1..6) :=
|
|
|
221 (Standard_Input, Standard_Output, Standard_Error,
|
|
|
222 Current_Input, Current_Output, Current_Error);
|
|
|
223 begin
|
|
|
224
|
|
|
225 -- Compare the current environment with that of the saved
|
|
|
226 -- initial environment.
|
|
|
227
|
|
|
228 if Current_Env /= Initial_Env then
|
|
|
229 Report.Failed("Restored file environment was not the same " &
|
|
|
230 "as the initial file environment");
|
|
|
231 end if;
|
|
|
232 end;
|
|
|
233 end Restore_Initial_Environment;
|
|
|
234
|
|
|
235
|
|
|
236
|
|
|
237 procedure Verify_Files (O_File, E_File_1, E_File_2 : in File_Type) is
|
|
|
238 Str_1, Str_2, Str_3, Str_4, Str_5, Str_6 : String (1..80);
|
|
|
239 Len_1, Len_2, Len_3, Len_4, Len_5, Len_6 : Natural;
|
|
|
240 begin
|
|
|
241
|
|
|
242 -- Get the lines that are contained in all the files, and verify
|
|
|
243 -- them against the expected results.
|
|
|
244
|
|
|
245 Get_Line(O_File, Str_1, Len_1); -- The user defined output file
|
|
|
246 Get_Line(O_File, Str_2, Len_2); -- should contain two lines of data.
|
|
|
247
|
|
|
248 if Str_1(1..Len_1) /= Line_1 or
|
|
|
249 Str_2(1..Len_2) /= Line_2
|
|
|
250 then
|
|
|
251 Report.Failed("Incorrect results from Current_Output file");
|
|
|
252 end if;
|
|
|
253
|
|
|
254 Get_Line(E_File_1, Str_3, Len_3); -- The first error file received
|
|
|
255 Get_Line(E_File_1, Str_4, Len_4); -- two lines of data originally,
|
|
|
256 Get_Line(E_File_1, Str_5, Len_5); -- then had two additional lines
|
|
|
257 Get_Line(E_File_1, Str_6, Len_6); -- appended from the second error
|
|
|
258 -- file.
|
|
|
259 if Str_3(1..Len_3) /= Line_3 or
|
|
|
260 Str_4(1..Len_4) /= Line_4 or
|
|
|
261 Str_5(1..Len_5) /= Line_5 or
|
|
|
262 Str_6(1..Len_6) /= Line_6
|
|
|
263 then
|
|
|
264 Report.Failed("Incorrect results from first Error file");
|
|
|
265 end if;
|
|
|
266
|
|
|
267 Get_Line(E_File_2, Str_5, Len_5); -- The second error file
|
|
|
268 Get_Line(E_File_2, Str_6, Len_6); -- received two lines of data.
|
|
|
269
|
|
|
270 if Str_5(1..Len_5) /= Line_5 or
|
|
|
271 Str_6(1..Len_6) /= Line_6
|
|
|
272 then
|
|
|
273 Report.Failed("Incorrect results from second Error file");
|
|
|
274 end if;
|
|
|
275
|
|
|
276 end Verify_Files;
|
|
|
277
|
|
|
278
|
|
|
279
|
|
|
280 begin
|
|
|
281
|
|
|
282 Check_Initial_Environment (Initial_Environment);
|
|
|
283
|
|
|
284 -- Create user-defined text files that will be set to serve as current
|
|
|
285 -- system input, output, and error files.
|
|
|
286
|
|
|
287 New_File (New_Input_File, Out_File, 1); -- Will be reset prior to use.
|
|
|
288 New_File (New_Output_File, Out_File, 2);
|
|
|
289 New_File (New_Error_File_1, Out_File, 3);
|
|
|
290 New_File (New_Error_File_2, Out_File, 4);
|
|
|
291
|
|
|
292 -- Enter several lines of text into the new input file. This file will
|
|
|
293 -- be reset to mode In_File to function as the current system input file.
|
|
|
294 -- Note: File_Access value used as parameter to this procedure.
|
|
|
295
|
|
|
296 Load_Input_File (New_Input_Ptr);
|
|
|
297
|
|
|
298 -- Reset the New_Input_File to mode In_File, to allow it to act as the
|
|
|
299 -- current system input file.
|
|
|
300
|
|
|
301 Reset1:
|
|
|
302 begin
|
|
|
303 Reset (New_Input_File, In_File);
|
|
|
304 exception
|
|
|
305 when Ada.Text_IO.Use_Error =>
|
|
|
306 Report.Not_Applicable
|
|
|
307 ( "Reset to In_File not supported for Text_IO - 1" );
|
|
|
308 raise No_Reset;
|
|
|
309 end Reset1;
|
|
|
310
|
|
|
311 -- Establish new files that will function as the current system Input,
|
|
|
312 -- Output, and Error files.
|
|
|
313
|
|
|
314 Set_Input (New_Input_File);
|
|
|
315 Set_Output(New_Output_Ptr.all);
|
|
|
316 Set_Error (New_Error_Ptr.all);
|
|
|
317
|
|
|
318 -- Perform various file processing tasks, exercising specific new
|
|
|
319 -- Text_IO functionality.
|
|
|
320 --
|
|
|
321 -- Read two lines from Current_Input and write them to Current_Output.
|
|
|
322
|
|
|
323 for i in 1..2 loop
|
|
|
324 Get_Line(Current_Input, Line, Length);
|
|
|
325 Put_Line(Current_Output, Line(1..Length));
|
|
|
326 end loop;
|
|
|
327
|
|
|
328 -- Read two lines from Current_Input and write them to Current_Error.
|
|
|
329
|
|
|
330 for i in 1..2 loop
|
|
|
331 Get_Line(Current_Input, Line, Length);
|
|
|
332 Put_Line(Current_Error, Line(1..Length));
|
|
|
333 end loop;
|
|
|
334
|
|
|
335 -- Reset the Current system error file.
|
|
|
336
|
|
|
337 Set_Error (New_Error_File_2);
|
|
|
338
|
|
|
339 -- Read two lines from Current_Input and write them to Current_Error.
|
|
|
340
|
|
|
341 for i in 1..2 loop
|
|
|
342 Get_Line(Current_Input, Line, Length);
|
|
|
343 Put_Line(Current_Error, Line(1..Length));
|
|
|
344 end loop;
|
|
|
345
|
|
|
346 -- At this point in the processing, the new Output file, and each of
|
|
|
347 -- the two Error files, contain two lines of data.
|
|
|
348 -- Note that New_Error_File_1 has been replaced by New_Error_File_2
|
|
|
349 -- as the current system error file, allowing New_Error_File_1 to be
|
|
|
350 -- reset (Mode_Error raised otherwise).
|
|
|
351 --
|
|
|
352 -- Reset the first Error file to Append_File mode, and then set it to
|
|
|
353 -- function as the current system error file.
|
|
|
354
|
|
|
355 Reset2:
|
|
|
356 begin
|
|
|
357 Reset (New_Error_File_1, Append_File);
|
|
|
358 exception
|
|
|
359 when Ada.Text_IO.Use_Error =>
|
|
|
360 Report.Not_Applicable
|
|
|
361 ( "Reset to Append_File not supported for Text_IO - 2" );
|
|
|
362 raise No_Reset;
|
|
|
363 end Reset2;
|
|
|
364
|
|
|
365 Set_Error (New_Error_File_1);
|
|
|
366
|
|
|
367 -- Reset the second Error file to In_File mode, then set it to become
|
|
|
368 -- the current system input file.
|
|
|
369
|
|
|
370 Reset3:
|
|
|
371 begin
|
|
|
372 Reset (New_Error_File_2, In_File);
|
|
|
373 exception
|
|
|
374 when Ada.Text_IO.Use_Error =>
|
|
|
375 Report.Not_Applicable
|
|
|
376 ( "Reset to In_File not supported for Text_IO - 3" );
|
|
|
377 raise No_Reset;
|
|
|
378 end Reset3;
|
|
|
379
|
|
|
380 New_Error_Ptr := New_Error_File_2'Access;
|
|
|
381 Set_Input (New_Error_Ptr.all);
|
|
|
382
|
|
|
383 -- Append all of the text lines (2) in the new current system input
|
|
|
384 -- file onto the current system error file.
|
|
|
385
|
|
|
386 while not End_Of_File(Current_Input) loop
|
|
|
387 Get_Line(Current_Input, Line, Length);
|
|
|
388 Put_Line(Current_Error, Line(1..Length));
|
|
|
389 end loop;
|
|
|
390
|
|
|
391 -- Restore the original system file environment, based upon the values
|
|
|
392 -- stored at the start of this test.
|
|
|
393 -- Check that the original environment has been restored.
|
|
|
394
|
|
|
395 Restore_Initial_Environment (Initial_Environment);
|
|
|
396
|
|
|
397 -- Reset all three files to In_File_Mode prior to verification.
|
|
|
398 -- Note: If these three files had still been the designated Current
|
|
|
399 -- Input, Output, or Error files for the system, a Reset
|
|
|
400 -- operation at this point would raise Mode_Error.
|
|
|
401 -- However, at this point, the environment has been restored to
|
|
|
402 -- its original state, and these user-defined files are no longer
|
|
|
403 -- designated as current system files, allowing a Reset.
|
|
|
404
|
|
|
405 Reset4:
|
|
|
406 begin
|
|
|
407 Reset(New_Error_File_1, In_File);
|
|
|
408 exception
|
|
|
409 when Ada.Text_IO.Use_Error =>
|
|
|
410 Report.Not_Applicable
|
|
|
411 ( "Reset to In_File not supported for Text_IO - 4" );
|
|
|
412 raise No_Reset;
|
|
|
413 end Reset4;
|
|
|
414
|
|
|
415 Reset5:
|
|
|
416 begin
|
|
|
417 Reset(New_Error_File_2, In_File);
|
|
|
418 exception
|
|
|
419 when Ada.Text_IO.Use_Error =>
|
|
|
420 Report.Not_Applicable
|
|
|
421 ( "Reset to In_File not supported for Text_IO - 5" );
|
|
|
422 raise No_Reset;
|
|
|
423 end Reset5;
|
|
|
424
|
|
|
425 Reset6:
|
|
|
426 begin
|
|
|
427 Reset(New_Output_File, In_File);
|
|
|
428 exception
|
|
|
429 when Ada.Text_IO.Use_Error =>
|
|
|
430 Report.Not_Applicable
|
|
|
431 ( "Reset to In_File not supported for Text_IO - 6" );
|
|
|
432 raise No_Reset;
|
|
|
433 end Reset6;
|
|
|
434
|
|
|
435 -- Check that all the files contain the appropriate data.
|
|
|
436
|
|
|
437 Verify_Files (New_Output_File, New_Error_File_1, New_Error_File_2);
|
|
|
438
|
|
|
439 exception
|
|
|
440 when No_Reset =>
|
|
|
441 null;
|
|
|
442 when Non_Applicable_System =>
|
|
|
443 Report.Not_Applicable("System not capable of supporting external " &
|
|
|
444 "text files -- Name_Error/Use_Error raised " &
|
|
|
445 "during text file creation");
|
|
|
446 Not_Applicable_System := True;
|
|
|
447 when The_Error : others =>
|
|
|
448 Report.Failed ("The following exception was raised in the " &
|
|
|
449 "Test_Block: " & Exception_Name(The_Error));
|
|
|
450 end Test_Block;
|
|
|
451
|
|
|
452 Delete_Block:
|
|
|
453 begin
|
|
|
454 Delete_File ( New_Input_File, 1 );
|
|
|
455 Delete_File ( New_Output_File, 2 );
|
|
|
456 Delete_File ( New_Error_File_1, 3 );
|
|
|
457 Delete_File ( New_Error_File_2, 4 );
|
|
|
458 end Delete_Block;
|
|
|
459
|
|
|
460 Report.Result;
|
|
|
461
|
|
|
462 end CXAA016;
|
