CbC/CbC_gcc: gcc/testsuite/ada/acats/tests/cxa/cxaa016.a comparison

comparison gcc/testsuite/ada/acats/tests/cxa/cxaa016.a @ 111:04ced10e8804

gcc 7

author	kono
date	Fri, 27 Oct 2017 22:46:09 +0900
parents
children

comparison

equal deleted inserted replaced

-:561a7518be6b
+:04ced10e8804
+-- 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;

Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/ada/acats/tests/cxa/cxaa016.a @ 111:04ced10e8804