OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxa/] [cxaa016.a] - Blame information for rev 149

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn
-- 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;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.