summaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a
blob: 8ae69a126648d3456a9cd07b10daf103bc1c8515 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
-- CXAA016.A
--
--                             Grant of Unlimited Rights
--
--     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
--     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained 
--     unlimited rights in the software and documentation contained herein.
--     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making 
--     this public release, the Government intends to confer upon all 
--     recipients unlimited rights  equal to those held by the Government.  
--     These rights include rights to use, duplicate, release or disclose the 
--     released technical data and computer software in whole or in part, in 
--     any manner and for any purpose whatsoever, and to have or permit others 
--     to do so.
--
--                                    DISCLAIMER
--
--     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
--     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED 
--     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
--     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE 
--     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
--     PARTICULAR PURPOSE OF SAID MATERIAL.
--*
--
-- OBJECTIVE:
--      Check that the type File_Access is available in Ada.Text_IO, and that
--      objects of this type designate File_Type objects.
--      Check that function Set_Error will set the current default error file.
--      Check that versions of Ada.Text_IO functions Standard_Input,
--      Standard_Output, Standard_Error return File_Access values designating
--      the standard system input, output, and error files.
--      Check that versions of Ada.Text_IO functions Current_Input,
--      Current_Output, Current_Error return File_Access values designating
--      the current system input, output, and error files.
--      
-- TEST DESCRIPTION:
--      This test tests the use of File_Access objects in referring 
--      to File_Type objects, as well as several new functions that return 
--      File_Access objects as results.
--      Four user-defined files are created.  These files will be set to 
--      function as current system input, output, and error files.
--      Data will be read from and written to these files during the
--      time at which they function as the current system files.  
--      An array of File_Access objects will be defined.  It will be 
--      initialized using functions that return File_Access objects 
--      referencing the Standard and Current Input, Output, and Error files.
--      This "saves" the initial system environment, which will be modified
--      to use the user-defined files as the current default Input, Output,
--      and Error files.  At the end of the test, the data in this array 
--      will be used to restore the initial system environment.
--      
-- APPLICABILITY CRITERIA: 
--      This test is applicable to implementations capable of supporting
--      external Text_IO files.
--
--       
-- CHANGE HISTORY:
--      25 May 95   SAIC    Initial prerelease version.
--      22 Apr 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
--      26 Feb 97   PWB.CTA Allowed for non-support of some IO operations.
--      18 Jan 99   RLB     Repaired to allow Not_Applicable systems to
--                          fail delete.
--!

with Ada.Text_IO;
package CXAA016_0 is
   New_Input_File,
   New_Output_File,
   New_Error_File_1,
   New_Error_File_2 : aliased Ada.Text_IO.File_Type;
end CXAA016_0;


with Report;
with Ada.Exceptions;
with Ada.Text_IO; use Ada.Text_IO;
with CXAA016_0;   use CXAA016_0;

procedure CXAA016 is
   
   Non_Applicable_System : exception;
   No_Reset              : exception;
   Not_Applicable_System : Boolean := False;

   procedure Delete_File ( A_File : in out Ada.Text_IO.File_Type;
                           ID_Num : in     Integer ) is
   begin
      if not Ada.Text_IO.Is_Open ( A_File ) then
         Ada.Text_IO.Open ( A_File, 
                            Ada.Text_IO.In_File, 
                            Report.Legal_File_Name ( ID_Num ) );
      end if;
      Ada.Text_IO.Delete ( A_File );
   exception
      when Ada.Text_IO.Name_Error =>
         if Not_Applicable_System then
            null; -- File probably wasn't created.
         else
            Report.Failed ( "Can't open file for Text_IO" );
         end if;
      when Ada.Text_IO.Use_Error =>
         if Not_Applicable_System then
            null; -- File probably wasn't created.
         else
            Report.Failed ( "Delete not properly implemented for Text_IO" );
         end if;
      when others                =>
         Report.Failed ( "Unexpected exception in Delete_File" );
   end Delete_File;

begin

   Report.Test ("CXAA016", "Check that the type File_Access is available " &
                           "in Ada.Text_IO, and that objects of this "     &
                           "type designate File_Type objects");
   Test_Block:
   declare

      use Ada.Exceptions;

      type System_File_Array_Type is 
        array (Integer range <>) of File_Access;        

      -- Fill the following array with the File_Access results of six
      -- functions.

      Initial_Environment : System_File_Array_Type(1..6) := 
                              ( Standard_Input,
                                Standard_Output,
                                Standard_Error,
                                Current_Input,    
                                Current_Output,
                                Current_Error );

      New_Input_Ptr    : File_Access := New_Input_File'Access;
      New_Output_Ptr   : File_Access := New_Output_File'Access;
      New_Error_Ptr    : File_Access := New_Error_File_1'Access;

      Line   : String(1..80);
      Length : Natural := 0;

      Line_1 : constant String := "This is the first line in the Output file";
      Line_2 : constant String := "This is the next line in the Output file";
      Line_3 : constant String := "This is the first line in Error file 1";
      Line_4 : constant String := "This is the next line in Error file 1";
      Line_5 : constant String := "This is the first line in Error file 2";
      Line_6 : constant String := "This is the next line in Error file 2";



      procedure New_File (The_File : in out File_Type;
                          Mode     : in     File_Mode;
                          Next     : in     Integer) is
      begin
         Create (The_File, Mode, Report.Legal_File_Name(Next));
      exception
         -- The following two exceptions may be raised if a system is not
         -- capable of supporting external Text_IO files.  The handler will
         -- raise a user-defined exception which will result in a 
         -- Not_Applicable result for the test.
         when Use_Error | Name_Error => raise Non_Applicable_System;
      end New_File;



      procedure Check_Initial_Environment (Env : System_File_Array_Type) is
      begin
        -- Check that the system has defined the following sources/
        -- destinations for input/output/error, and that the six functions
        -- returning File_Access values are available.
        if not (Env(1) = Standard_Input  and
                Env(2) = Standard_Output and
                Env(3) = Standard_Error  and    
                Env(4) = Current_Input   and
                Env(5) = Current_Output  and
                Env(6) = Current_Error) 
        then
           Report.Failed("At the start of the test, the Standard and " &
                         "Current File_Access values associated with " &
                         "system Input, Output, and Error files do "   &
                         "not correspond");
        end if;
      end Check_Initial_Environment;



      procedure Load_Input_File (Input_Ptr : in File_Access) is
      begin
         -- Load data into the file that will function as the user-defined
         -- system input file.
         Put_Line(Input_Ptr.all, Line_1);
         Put_Line(Input_Ptr.all, Line_2);
         Put_Line(Input_Ptr.all, Line_3);
         Put_Line(Input_Ptr.all, Line_4);
         Put_Line(Input_Ptr.all, Line_5);
         Put_Line(Input_Ptr.all, Line_6);
      end Load_Input_File;



      procedure Restore_Initial_Environment 
                  (Initial_Env : System_File_Array_Type) is 
      begin
         -- Restore the Current Input, Output, and Error files to their
         -- original states.

         Set_Input (Initial_Env(4).all);
         Set_Output(Initial_Env(5).all);
         Set_Error (Initial_Env(6).all);

         -- At this point, the user-defined files that were functioning as
         -- the Current Input, Output, and Error files have been replaced in
         -- that capacity by the state of the original environment.

         declare

            -- Capture the state of the current environment.

            Current_Env : System_File_Array_Type (1..6) := 
                            (Standard_Input, Standard_Output, Standard_Error,
                             Current_Input,  Current_Output,  Current_Error);
         begin

            -- Compare the current environment with that of the saved  
            -- initial environment.

            if Current_Env /= Initial_Env then
               Report.Failed("Restored file environment was not the same " &
                             "as the initial file environment");
            end if;
         end;
      end Restore_Initial_Environment;



      procedure Verify_Files (O_File, E_File_1, E_File_2 : in File_Type) is
         Str_1, Str_2, Str_3, Str_4, Str_5, Str_6 : String (1..80);
         Len_1, Len_2, Len_3, Len_4, Len_5, Len_6 : Natural;
      begin
         
         -- Get the lines that are contained in all the files, and verify
         -- them against the expected results.

         Get_Line(O_File, Str_1, Len_1);  -- The user defined output file 
         Get_Line(O_File, Str_2, Len_2);  -- should contain two lines of data.
       
         if Str_1(1..Len_1) /= Line_1 or
            Str_2(1..Len_2) /= Line_2
         then
            Report.Failed("Incorrect results from Current_Output file");
         end if;

         Get_Line(E_File_1, Str_3, Len_3);  -- The first error file received 
         Get_Line(E_File_1, Str_4, Len_4);  -- two lines of data originally,
         Get_Line(E_File_1, Str_5, Len_5);  -- then had two additional lines
         Get_Line(E_File_1, Str_6, Len_6);  -- appended from the second error
                                            -- file.
         if Str_3(1..Len_3) /= Line_3 or
            Str_4(1..Len_4) /= Line_4 or
            Str_5(1..Len_5) /= Line_5 or
            Str_6(1..Len_6) /= Line_6 
         then
            Report.Failed("Incorrect results from first Error file");
         end if;

         Get_Line(E_File_2, Str_5, Len_5);  -- The second error file
         Get_Line(E_File_2, Str_6, Len_6);  -- received two lines of data.

         if Str_5(1..Len_5) /= Line_5 or
            Str_6(1..Len_6) /= Line_6 
         then
            Report.Failed("Incorrect results from second Error file");
         end if;

      end Verify_Files;



   begin

      Check_Initial_Environment (Initial_Environment);

      -- Create user-defined text files that will be set to serve as current
      -- system input, output, and error files.

      New_File (New_Input_File,   Out_File, 1); -- Will be reset prior to use.
      New_File (New_Output_File,  Out_File, 2);
      New_File (New_Error_File_1, Out_File, 3);
      New_File (New_Error_File_2, Out_File, 4);

      -- Enter several lines of text into the new input file.  This file will
      -- be reset to mode In_File to function as the current system input file.
      -- Note: File_Access value used as parameter to this procedure.
      
      Load_Input_File (New_Input_Ptr);

      -- Reset the New_Input_File to mode In_File, to allow it to act as the
      -- current system input file.

      Reset1:
      begin
         Reset (New_Input_File, In_File);
      exception
         when Ada.Text_IO.Use_Error =>
            Report.Not_Applicable
               ( "Reset to In_File not supported for Text_IO - 1" );
            raise No_Reset;
      end Reset1;

      -- Establish new files that will function as the current system Input,
      -- Output, and Error files.
      
      Set_Input (New_Input_File);
      Set_Output(New_Output_Ptr.all);
      Set_Error (New_Error_Ptr.all);      

      -- Perform various file processing tasks, exercising specific new
      -- Text_IO functionality.
      --
      -- Read two lines from Current_Input and write them to Current_Output.

      for i in 1..2 loop
         Get_Line(Current_Input,  Line, Length);
         Put_Line(Current_Output, Line(1..Length));
      end loop;

      -- Read two lines from Current_Input and write them to Current_Error.

      for i in 1..2 loop
         Get_Line(Current_Input, Line, Length);
         Put_Line(Current_Error, Line(1..Length));
      end loop;

      -- Reset the Current system error file.

      Set_Error (New_Error_File_2);      

      -- Read two lines from Current_Input and write them to Current_Error.

      for i in 1..2 loop
         Get_Line(Current_Input, Line, Length);
         Put_Line(Current_Error, Line(1..Length));
      end loop;

      -- At this point in the processing, the new Output file, and each of
      -- the two Error files, contain two lines of data.
      -- Note that New_Error_File_1 has been replaced by New_Error_File_2
      -- as the current system error file, allowing New_Error_File_1 to be
      -- reset (Mode_Error raised otherwise).
      --
      -- Reset the first Error file to Append_File mode, and then set it to 
      -- function as the current system error file.

      Reset2:
      begin
         Reset (New_Error_File_1, Append_File);
      exception
         when Ada.Text_IO.Use_Error =>
            Report.Not_Applicable
               ( "Reset to Append_File not supported for Text_IO - 2" );
            raise No_Reset;
      end Reset2;

      Set_Error (New_Error_File_1);

      -- Reset the second Error file to In_File mode, then set it to become
      -- the current system input file.

      Reset3:
      begin
         Reset (New_Error_File_2, In_File);
      exception
         when Ada.Text_IO.Use_Error =>
            Report.Not_Applicable
               ( "Reset to In_File not supported for Text_IO - 3" );
            raise No_Reset;
      end Reset3;

      New_Error_Ptr := New_Error_File_2'Access; 
      Set_Input (New_Error_Ptr.all);

      -- Append all of the text lines (2) in the new current system input
      -- file onto the current system error file.

      while not End_Of_File(Current_Input) loop
         Get_Line(Current_Input, Line, Length);
         Put_Line(Current_Error, Line(1..Length));
      end loop;

      -- Restore the original system file environment, based upon the values
      -- stored at the start of this test.
      -- Check that the original environment has been restored.

      Restore_Initial_Environment (Initial_Environment);

      -- Reset all three files to In_File_Mode prior to verification.
      -- Note: If these three files had still been the designated Current
      --       Input, Output, or Error files for the system, a Reset 
      --       operation at this point would raise Mode_Error.
      --       However, at this point, the environment has been restored to
      --       its original state, and these user-defined files are no longer
      --       designated as current system files, allowing a Reset.

      Reset4:
      begin
         Reset(New_Error_File_1, In_File);
      exception
         when Ada.Text_IO.Use_Error =>
            Report.Not_Applicable
               ( "Reset to In_File not supported for Text_IO - 4" );
            raise No_Reset;
      end Reset4;

      Reset5:
      begin
         Reset(New_Error_File_2, In_File);
      exception
         when Ada.Text_IO.Use_Error =>
            Report.Not_Applicable
               ( "Reset to In_File not supported for Text_IO - 5" );
            raise No_Reset;
      end Reset5;

      Reset6:
      begin
         Reset(New_Output_File,  In_File);
      exception
         when Ada.Text_IO.Use_Error =>
            Report.Not_Applicable
               ( "Reset to In_File not supported for Text_IO - 6" );
            raise No_Reset;
      end Reset6;

      -- Check that all the files contain the appropriate data.

      Verify_Files (New_Output_File, New_Error_File_1, New_Error_File_2);

   exception
      when No_Reset =>
         null;
      when Non_Applicable_System =>
         Report.Not_Applicable("System not capable of supporting external " &
                               "text files -- Name_Error/Use_Error raised " &
                               "during text file creation");
         Not_Applicable_System := True;
      when The_Error : others => 
         Report.Failed ("The following exception was raised in the " &
                        "Test_Block: " & Exception_Name(The_Error));
   end Test_Block;

   Delete_Block:
   begin
      Delete_File ( New_Input_File, 1 );
      Delete_File ( New_Output_File, 2 );
      Delete_File ( New_Error_File_1, 3 );
      Delete_File ( New_Error_File_2, 4 );
   end Delete_Block;

   Report.Result;

end CXAA016;