diff options
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxa/cxaa016.a')
| -rw-r--r-- | gcc/testsuite/ada/acats/tests/cxa/cxaa016.a | 462 |
1 files changed, 0 insertions, 462 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a deleted file mode 100644 index 8ae69a12664..00000000000 --- a/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a +++ /dev/null @@ -1,462 +0,0 @@ --- 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; |