cxaa016.a

来自「用于进行gcc测试」· A 代码 · 共 463 行 · 第 1/2 页

      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;