Subversion Repositories openrisc

-- 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;