path: root/gcc/testsuite/ada/acats/tests/cxa/cxaa017.a

-- 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;