summaryrefslogtreecommitdiff
path: root/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/ada/acats/tests/cxa/cxaa016.a
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/ada/acats/tests/cxa/cxaa016.a')
-rw-r--r--gcc/testsuite/ada/acats/tests/cxa/cxaa016.a462
1 files changed, 462 insertions, 0 deletions
diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a b/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a
new file mode 100644
index 000000000..8ae69a126
--- /dev/null
+++ b/gcc/testsuite/ada/acats/tests/cxa/cxaa016.a
@@ -0,0 +1,462 @@
+-- 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;