URL
https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk
Subversion Repositories openrisc_me
[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [ada/] [acats/] [tests/] [cxa/] [cxaa016.a] - Rev 316
Go to most recent revision | Compare with Previous | Blame | View Log
-- 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;
Go to most recent revision | Compare with Previous | Blame | View Log