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/] [cxaa017.a] - Rev 294
Compare with Previous | Blame | View Log
-- CXAA017.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 Ada.Text_IO function Look_Ahead sets parameter End_Of_Line
-- to True if at the end of a line; otherwise check that it returns the
-- next character from a file (without consuming it), while setting
-- End_Of_Line to False.
--
-- Check that Ada.Text_IO function Get_Immediate will return the next
-- control or graphic character in parameter Item from the specified
-- file. Check that the version of Ada.Text_IO function Get_Immediate
-- with the Available parameter will, if a character is available in the
-- specified file, return the character in parameter Item, and set
-- parameter Available to True.
--
-- TEST DESCRIPTION:
-- This test exercises specific capabilities of two Text_IO subprograms,
-- Look_Ahead and Get_Immediate. A file is prepared that contains a
-- variety of graphic and control characters on several lines.
-- In processing this file, a call to Look_Ahead is performed to ensure
-- that characters are available, then individual characters are
-- extracted from the current line using Get_Immediate. The characters
-- returned from both subprogram calls are compared with the expected
-- character result. Processing on each file line continues until
-- Look_Ahead indicates that the end of the line is next. Separate
-- verification is performed to ensure that all characters of each line
-- are processed, and that the Available and End_Of_Line parameters
-- of the subprograms are properly set in the appropriate instances.
--
-- APPLICABILITY CRITERIA:
-- This test is applicable to implementations capable of supporting
-- external Text_IO files.
--
--
-- CHANGE HISTORY:
-- 30 May 95 SAIC Initial prerelease version.
-- 01 May 96 SAIC Incorporated reviewer comments for ACVC 2.1.
-- 26 Feb 97 PWB.CTA Allowed for non-support of some IO operations.
--!
with Ada.Text_IO;
package CXAA017_0 is
User_Defined_Input_File : aliased Ada.Text_IO.File_Type;
end CXAA017_0;
with CXAA017_0; use CXAA017_0;
with Ada.Characters.Latin_1;
with Ada.Exceptions;
with Ada.Text_IO;
with Report;
procedure CXAA017 is
use Ada.Characters.Latin_1;
use Ada.Exceptions;
use Ada.Text_IO;
Non_Applicable_System : exception;
No_Reset : exception;
begin
Report.Test ("CXAA017", "Check that Ada.Text_IO subprograms " &
"Look_Ahead and Get_Immediate are available " &
"and produce correct results");
Test_Block:
declare
User_Input_Ptr : File_Access := User_Defined_Input_File'Access;
UDLA_Char, -- Acronym UDLA => "User Defined Look Ahead"
UDGI_Char, -- Acronym UDGI => "User Defined Get Immediate"
TC_Char : Character := Ada.Characters.Latin_1.NUL;
UDLA_End_Of_Line,
UDGI_Available : Boolean := False;
Char_Pos : Natural;
-- This string contains five ISO 646 Control characters and six ISO 646
-- Graphic characters:
TC_String_1 : constant String := STX &
SI &
DC2 &
CAN &
US &
Space &
Ampersand &
Solidus &
'A' &
LC_X &
DEL;
-- This string contains two ISO 6429 Control and six ISO 6429 Graphic
-- characters:
TC_String_2 : constant String := IS4 &
SCI &
Yen_Sign &
Masculine_Ordinal_Indicator &
UC_I_Grave &
Multiplication_Sign &
LC_C_Cedilla &
LC_Icelandic_Thorn;
TC_Number_Of_Strings : constant := 2;
type String_Access_Type is access constant String;
type String_Ptr_Array_Type is
array (1..TC_Number_Of_Strings) of String_Access_Type;
TC_String_Ptr_Array : String_Ptr_Array_Type :=
(new String'(TC_String_1),
new String'(TC_String_2));
procedure Create_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 can 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 Create_New_File;
procedure Load_File (The_File : in out File_Type) is
-- This procedure will load several strings into the file denoted
-- by the input parameter. A call to New_Line will add line/page
-- termination characters, which will be available for processing
-- along with the text in the file.
begin
Put_Line (The_File, TC_String_Ptr_Array(1).all);
New_Line (The_File, Spacing => 1);
Put_Line (The_File, TC_String_Ptr_Array(2).all);
end Load_File;
begin
-- Create user-defined text file that will serve as the appropriate
-- sources of input to the procedures under test.
Create_New_File (User_Defined_Input_File, Out_File, 1);
-- Enter several lines of text into the new input file.
-- The characters that make up these text strings will be processed
-- using the procedures being exercised in this test.
Load_File (User_Defined_Input_File);
-- Check that Mode_Error is raised by Look_Ahead and Get_Immedidate
-- if the mode of the file object is not In_File.
-- Currently, the file mode is Out_File.
begin
Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line);
Report.Failed("Mode_Error not raised by Look_Ahead");
Report.Comment("This char should never be printed: " & UDLA_Char);
exception
when Mode_Error => null; -- OK, expected exception.
when The_Error : others =>
Report.Failed ("The following exception was raised during the " &
"check that Look_Ahead raised Mode_Error when " &
"provided a file object that is not in In_File " &
"mode: " & Exception_Name(The_Error));
end;
begin
Get_Immediate(User_Defined_Input_File, UDGI_Char);
Report.Failed("Mode_Error not raised by Get_Immediate");
Report.Comment("This char should never be printed: " & UDGI_Char);
exception
when Mode_Error => null; -- OK, expected exception.
when The_Error : others =>
Report.Failed ("The following exception was raised during the " &
"check that Get_Immediate raised Mode_Error " &
"when provided a file object that is not in " &
"In_File mode: " & Exception_Name(The_Error));
end;
-- The file will then be reset to In_File mode to properly function as
-- a source of input.
Reset1:
begin
Reset (User_Defined_Input_File, In_File);
exception
when Ada.Text_IO.Use_Error =>
Report.Not_Applicable
( "Reset to In_File not supported for Text_IO" );
raise No_Reset;
end Reset1;
-- Process the input file, exercising various Text_IO
-- functionality, and validating the results at each step.
-- Note: The designated File_Access object is used in processing
-- the New_Default_Input_File in the second loop below.
-- Process characters in first line of text of each file.
Char_Pos := 1;
-- Check that the first line is not blank.
Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line);
while not UDLA_End_Of_Line loop
-- Use the Get_Immediate procedure on the file to get the next
-- available character on the current line.
Get_Immediate(User_Defined_Input_File, UDGI_Char);
-- Check that the characters returned by both procedures are the
-- same, and that they match the expected character from the file.
if UDLA_Char /= TC_String_Ptr_Array(1).all(Char_Pos) or
UDGI_Char /= TC_String_Ptr_Array(1).all(Char_Pos)
then
Report.Failed("Incorrect retrieval of character " &
Integer'Image(Char_Pos) & " of first string");
end if;
-- Increment the character position counter.
Char_Pos := Char_Pos + 1;
-- Check the next character on the line. If at the end of line,
-- the processing flow will exit the While loop.
Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line);
end loop;
-- Check to ensure that the "end of line" results returned from the
-- Look_Ahead procedure (used to exit the above While loop) corresponds
-- with the result of Function End_Of_Line.
if not End_Of_Line(User_Defined_Input_File)
then
Report.Failed("Result of procedure Look_Ahead that indicated " &
"being at the end of the line does not correspond " &
"with the result of function End_Of_Line");
end if;
-- Check that all characters in the string were processed.
if Char_Pos-1 /= TC_String_1'Length then
Report.Failed("Not all of the characters on the first line " &
"were processed");
end if;
-- Call procedure Skip_Line to advance beyond the end of the first line.
Skip_Line(User_Defined_Input_File);
-- Process the second line in the file (a blank line).
Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line);
if not UDLA_End_Of_Line then
Report.Failed("Incorrect end of line determination from procedure " &
"Look_Ahead when processing a blank line");
end if;
-- Call procedure Skip_Line to advance beyond the end of the second line.
Skip_Line(User_Input_Ptr.all);
-- Process characters in the third line of the file (second line
-- of text)
-- Note: The version of Get_Immediate used in processing this line has
-- the Boolean parameter Available.
Char_Pos := 1;
-- Check whether the line is blank (i.e., at end of line, page, or file).
Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line);
while not UDLA_End_Of_Line loop
-- Use the Get_Immediate procedure on the file to get access to the
-- next character on the current line.
Get_Immediate(User_Input_Ptr.all, UDGI_Char, UDGI_Available);
-- Check that the Available parameter of Get_Immediate was set
-- to indicate that a character was available in the file.
-- Check that the characters returned by both procedures are the
-- same, and they all match the expected character from the file.
if not UDGI_Available or
UDLA_Char /= TC_String_Ptr_Array(2).all(Char_Pos) or
UDGI_Char /= TC_String_Ptr_Array(2).all(Char_Pos)
then
Report.Failed("Incorrect retrieval of character " &
Integer'Image(Char_Pos) & " of second string");
end if;
-- Increment the character position counter.
Char_Pos := Char_Pos + 1;
-- Check the next character on the line. If at the end of line,
-- the processing flow will exit the While loop.
Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line);
end loop;
-- Check to ensure that the "end of line" results returned from the
-- Look_Ahead procedure (used to exit the above While loop) corresponds
-- with the result of Function End_Of_Line.
if not End_Of_Line(User_Defined_Input_File)
then
Report.Failed("Result of procedure Look_Ahead that indicated " &
"being at the end of the line does not correspond " &
"with the result of function End_Of_Line");
end if;
-- Check that all characters in the second string were processed.
if Char_Pos-1 /= TC_String_2'Length then
Report.Failed("Not all of the characters on the second line " &
"were processed");
end if;
Deletion:
begin
-- Delete the user defined file.
if Is_Open(User_Defined_Input_File) then
Delete(User_Defined_Input_File);
else
Open(User_Defined_Input_File, Out_File, Report.Legal_File_Name(1));
Delete(User_Defined_Input_File);
end if;
exception
when others =>
Report.Failed
( "Delete not properly implemented for Text_IO" );
end Deletion;
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");
when The_Error : others =>
Report.Failed ("The following exception was raised in the " &
"Test_Block: " & Exception_Name(The_Error));
end Test_Block;
Report.Result;
end CXAA017;