gomp-20050608-branch/gcc/testsuite/ada/acats/tests/cxa/cxaa017.a

   1 -- CXAA017.A
   2 --
   3 --                             Grant of Unlimited Rights
   4 --
   5 --     Under contracts F33600-87-D-0337, F33600-84-D-0280, MDA903-79-C-0687,
   6 --     F08630-91-C-0015, and DCA100-97-D-0025, the U.S. Government obtained
   7 --     unlimited rights in the software and documentation contained herein.
   8 --     Unlimited rights are defined in DFAR 252.227-7013(a)(19).  By making
   9 --     this public release, the Government intends to confer upon all
  10 --     recipients unlimited rights  equal to those held by the Government.
  11 --     These rights include rights to use, duplicate, release or disclose the
  12 --     released technical data and computer software in whole or in part, in
  13 --     any manner and for any purpose whatsoever, and to have or permit others
  14 --     to do so.
  15 --
  16 --                                    DISCLAIMER
  17 --
  18 --     ALL MATERIALS OR INFORMATION HEREIN RELEASED, MADE AVAILABLE OR
  19 --     DISCLOSED ARE AS IS.  THE GOVERNMENT MAKES NO EXPRESS OR IMPLIED
  20 --     WARRANTY AS TO ANY MATTER WHATSOEVER, INCLUDING THE CONDITIONS OF THE
  21 --     SOFTWARE, DOCUMENTATION OR OTHER INFORMATION RELEASED, MADE AVAILABLE
  22 --     OR DISCLOSED, OR THE OWNERSHIP, MERCHANTABILITY, OR FITNESS FOR A
  23 --     PARTICULAR PURPOSE OF SAID MATERIAL.
  24 --*
  25 --
  26 -- OBJECTIVE:
  27 --      Check that Ada.Text_IO function Look_Ahead sets parameter End_Of_Line
  28 --      to True if at the end of a line; otherwise check that it returns the
  29 --      next character from a file (without consuming it), while setting
  30 --      End_Of_Line to False.
  31 --
  32 --      Check that Ada.Text_IO function Get_Immediate will return the next
  33 --      control or graphic character in parameter Item from the specified
  34 --      file.  Check that the version of Ada.Text_IO function Get_Immediate
  35 --      with the Available parameter will, if a character is available in the
  36 --      specified file, return the character in parameter Item, and set
  37 --      parameter Available to True.
  38 --
  39 -- TEST DESCRIPTION:
  40 --      This test exercises specific capabilities of two Text_IO subprograms,
  41 --      Look_Ahead and Get_Immediate.  A file is prepared that contains a
  42 --      variety of graphic and control characters on several lines.
  43 --      In processing this file, a call to Look_Ahead is performed to ensure
  44 --      that characters are available, then individual characters are
  45 --      extracted from the current line using Get_Immediate.  The characters
  46 --      returned from both subprogram calls are compared with the expected
  47 --      character result.  Processing on each file line continues until
  48 --      Look_Ahead indicates that the end of the line is next.  Separate
  49 --      verification is performed to ensure that all characters of each line
  50 --      are processed, and that the Available and End_Of_Line parameters
  51 --      of the subprograms are properly set in the appropriate instances.
  52 --
  53 -- APPLICABILITY CRITERIA:
  54 --      This test is applicable to implementations capable of supporting
  55 --      external Text_IO files.
  56 --
  57 --
  58 -- CHANGE HISTORY:
  59 --      30 May 95   SAIC    Initial prerelease version.
  60 --      01 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
  61 --      26 Feb 97   PWB.CTA Allowed for non-support of some IO operations.
  62 --!
  63
  64 with Ada.Text_IO;
  65 package CXAA017_0 is
  66
  67    User_Defined_Input_File : aliased Ada.Text_IO.File_Type;
  68
  69 end CXAA017_0;
  70
  71
  72 with CXAA017_0; use CXAA017_0;
  73 with Ada.Characters.Latin_1;
  74 with Ada.Exceptions;
  75 with Ada.Text_IO;
  76 with Report;
  77
  78 procedure CXAA017 is
  79
  80    use Ada.Characters.Latin_1;
  81    use Ada.Exceptions;
  82    use Ada.Text_IO;
  83
  84    Non_Applicable_System : exception;
  85    No_Reset            : exception;
  86
  87 begin
  88
  89    Report.Test ("CXAA017", "Check that Ada.Text_IO subprograms "         &
  90                            "Look_Ahead and Get_Immediate are available " &
  91                            "and produce correct results");
  92
  93    Test_Block:
  94    declare
  95
  96       User_Input_Ptr    : File_Access := User_Defined_Input_File'Access;
  97
  98       UDLA_Char,          -- Acronym UDLA => "User Defined Look Ahead"
  99       UDGI_Char,          -- Acronym UDGI => "User Defined Get Immediate"
 100       TC_Char           : Character := Ada.Characters.Latin_1.NUL;
 101
 102       UDLA_End_Of_Line,
 103       UDGI_Available    : Boolean   := False;
 104
 105       Char_Pos          : Natural;
 106
 107       -- This string contains five ISO 646 Control characters and six ISO 646
 108       -- Graphic characters:
 109       TC_String_1  : constant String := STX       &
 110                                         SI        &
 111                                         DC2       &
 112                                         CAN       &
 113                                         US        &
 114                                         Space     &
 115                                         Ampersand &
 116                                         Solidus   &
 117                                         'A'       &
 118                                         LC_X      &
 119                                         DEL;
 120
 121       -- This string contains two ISO 6429 Control and six ISO 6429 Graphic
 122       -- characters:
 123       TC_String_2  : constant String := IS4                         &
 124                                         SCI                         &
 125                                         Yen_Sign                    &
 126                                         Masculine_Ordinal_Indicator &
 127                                         UC_I_Grave                  &
 128                                         Multiplication_Sign         &
 129                                         LC_C_Cedilla                &
 130                                         LC_Icelandic_Thorn;
 131
 132       TC_Number_Of_Strings : constant := 2;
 133
 134       type String_Access_Type    is access constant String;
 135       type String_Ptr_Array_Type is
 136         array (1..TC_Number_Of_Strings) of String_Access_Type;
 137
 138       TC_String_Ptr_Array : String_Ptr_Array_Type :=
 139                               (new String'(TC_String_1),
 140                                new String'(TC_String_2));
 141
 142
 143
 144       procedure Create_New_File (The_File : in out File_Type;
 145                                  Mode     : in     File_Mode;
 146                                  Next     : in     Integer) is
 147       begin
 148          Create (The_File, Mode, Report.Legal_File_Name(Next));
 149       exception
 150          -- The following two exceptions can be raised if a system is not
 151          -- capable of supporting external Text_IO files.  The handler will
 152          -- raise a user-defined exception which will result in a
 153          -- Not_Applicable result for the test.
 154          when Use_Error | Name_Error => raise Non_Applicable_System;
 155       end Create_New_File;
 156
 157
 158
 159       procedure Load_File (The_File : in out File_Type) is
 160       -- This procedure will load several strings into the file denoted
 161       -- by the input parameter.  A call to New_Line will add line/page
 162       -- termination characters, which will be available  for processing
 163       -- along with the text in the file.
 164       begin
 165          Put_Line (The_File, TC_String_Ptr_Array(1).all);
 166          New_Line (The_File, Spacing => 1);
 167          Put_Line (The_File, TC_String_Ptr_Array(2).all);
 168       end Load_File;
 169
 170
 171    begin
 172
 173       -- Create user-defined text file that will serve as the appropriate
 174       -- sources of input to the procedures under test.
 175
 176       Create_New_File (User_Defined_Input_File, Out_File, 1);
 177
 178       -- Enter several lines of text into the new input file.
 179       -- The characters that make up these text strings will be processed
 180       -- using the procedures being exercised in this test.
 181
 182       Load_File (User_Defined_Input_File);
 183
 184       -- Check that Mode_Error is raised by Look_Ahead and Get_Immedidate
 185       -- if the mode of the file object is not In_File.
 186       -- Currently, the file mode is Out_File.
 187
 188       begin
 189          Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line);
 190          Report.Failed("Mode_Error not raised by Look_Ahead");
 191          Report.Comment("This char should never be printed: " & UDLA_Char);
 192       exception
 193          when Mode_Error => null;  -- OK, expected exception.
 194          when The_Error : others =>
 195             Report.Failed ("The following exception was raised during the " &
 196                            "check that Look_Ahead raised Mode_Error when "  &
 197                            "provided a file object that is not in In_File " &
 198                            "mode: " & Exception_Name(The_Error));
 199       end;
 200
 201       begin
 202          Get_Immediate(User_Defined_Input_File, UDGI_Char);
 203          Report.Failed("Mode_Error not raised by Get_Immediate");
 204          Report.Comment("This char should never be printed: " & UDGI_Char);
 205       exception
 206          when Mode_Error => null;  -- OK, expected exception.
 207          when The_Error : others =>
 208             Report.Failed ("The following exception was raised during the " &
 209                            "check that Get_Immediate raised Mode_Error "    &
 210                            "when provided a file object that is not in "    &
 211                            "In_File mode: " & Exception_Name(The_Error));
 212       end;
 213
 214
 215       -- The file will then be reset to In_File mode to properly function as
 216       -- a source of input.
 217
 218       Reset1:
 219       begin
 220          Reset (User_Defined_Input_File, In_File);
 221       exception
 222          when Ada.Text_IO.Use_Error =>
 223             Report.Not_Applicable
 224                ( "Reset to In_File not supported for Text_IO" );
 225             raise No_Reset;
 226       end Reset1;
 227
 228       -- Process the input file, exercising various Text_IO
 229       -- functionality, and validating the results at each step.
 230       -- Note: The designated File_Access object is used in processing
 231       --       the New_Default_Input_File in the second loop below.
 232
 233       -- Process characters in first line of text of each file.
 234
 235       Char_Pos := 1;
 236
 237       -- Check that the first line is not blank.
 238
 239       Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line);
 240
 241       while not UDLA_End_Of_Line loop
 242
 243          -- Use the Get_Immediate procedure on the file to get the next
 244          -- available character on the current line.
 245
 246          Get_Immediate(User_Defined_Input_File, UDGI_Char);
 247
 248          -- Check that the characters returned by both procedures are the
 249          -- same, and that they match the expected character from the file.
 250
 251          if UDLA_Char /= TC_String_Ptr_Array(1).all(Char_Pos) or
 252             UDGI_Char /= TC_String_Ptr_Array(1).all(Char_Pos)
 253          then
 254             Report.Failed("Incorrect retrieval of character " &
 255                           Integer'Image(Char_Pos) & " of first string");
 256          end if;
 257
 258          -- Increment the character position counter.
 259          Char_Pos := Char_Pos + 1;
 260
 261          -- Check the next character on the line.  If at the end of line,
 262          -- the processing flow will exit the While loop.
 263
 264          Look_Ahead(User_Defined_Input_File, UDLA_Char, UDLA_End_Of_Line);
 265
 266       end loop;
 267
 268       -- Check to ensure that the "end of line" results returned from the
 269       -- Look_Ahead procedure (used to exit the above While loop) corresponds
 270       -- with the result of Function End_Of_Line.
 271
 272       if not End_Of_Line(User_Defined_Input_File)
 273       then
 274          Report.Failed("Result of procedure Look_Ahead that indicated "    &
 275                        "being at the end of the line does not correspond " &
 276                        "with the result of function End_Of_Line");
 277       end if;
 278
 279       -- Check that all characters in the string were processed.
 280
 281       if Char_Pos-1 /= TC_String_1'Length then
 282          Report.Failed("Not all of the characters on the first line " &
 283                        "were processed");
 284       end if;
 285
 286
 287       -- Call procedure Skip_Line to advance beyond the end of the first line.
 288
 289       Skip_Line(User_Defined_Input_File);
 290
 291
 292       -- Process the second line in the file (a blank line).
 293
 294       Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line);
 295
 296       if not UDLA_End_Of_Line then
 297          Report.Failed("Incorrect end of line determination from procedure " &
 298                        "Look_Ahead when processing a blank line");
 299       end if;
 300
 301       -- Call procedure Skip_Line to advance beyond the end of the second line.
 302
 303       Skip_Line(User_Input_Ptr.all);
 304
 305
 306       -- Process characters in the third line of the file (second line
 307       -- of text)
 308       -- Note: The version of Get_Immediate used in processing this line has
 309       --       the Boolean parameter Available.
 310
 311       Char_Pos := 1;
 312
 313       -- Check whether the line is blank (i.e., at end of line, page, or file).
 314
 315       Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line);
 316
 317       while not UDLA_End_Of_Line loop
 318
 319          -- Use the Get_Immediate procedure on the file to get access to the
 320          -- next character on the current line.
 321
 322          Get_Immediate(User_Input_Ptr.all, UDGI_Char, UDGI_Available);
 323
 324          -- Check that the Available parameter of Get_Immediate was set
 325          -- to indicate that a character was available in the file.
 326          -- Check that the characters returned by both procedures are the
 327          -- same, and they all match the expected character from the file.
 328
 329          if not UDGI_Available                                or
 330             UDLA_Char /= TC_String_Ptr_Array(2).all(Char_Pos) or
 331             UDGI_Char /= TC_String_Ptr_Array(2).all(Char_Pos)
 332          then
 333             Report.Failed("Incorrect retrieval of character " &
 334                           Integer'Image(Char_Pos) & " of second string");
 335          end if;
 336
 337          -- Increment the character position counter.
 338
 339          Char_Pos := Char_Pos + 1;
 340
 341          -- Check the next character on the line.  If at the end of line,
 342          -- the processing flow will exit the While loop.
 343
 344          Look_Ahead(User_Input_Ptr.all, UDLA_Char, UDLA_End_Of_Line);
 345
 346       end loop;
 347
 348       -- Check to ensure that the "end of line" results returned from the
 349       -- Look_Ahead procedure (used to exit the above While loop) corresponds
 350       -- with the result of Function End_Of_Line.
 351
 352       if not End_Of_Line(User_Defined_Input_File)
 353       then
 354          Report.Failed("Result of procedure Look_Ahead that indicated "    &
 355                        "being at the end of the line does not correspond " &
 356                        "with the result of function End_Of_Line");
 357       end if;
 358
 359       -- Check that all characters in the second string were processed.
 360
 361       if Char_Pos-1 /= TC_String_2'Length then
 362          Report.Failed("Not all of the characters on the second line " &
 363                        "were processed");
 364       end if;
 365
 366
 367       Deletion:
 368       begin
 369          -- Delete the user defined file.
 370
 371          if Is_Open(User_Defined_Input_File) then
 372             Delete(User_Defined_Input_File);
 373          else
 374             Open(User_Defined_Input_File, Out_File, Report.Legal_File_Name(1));
 375             Delete(User_Defined_Input_File);
 376          end if;
 377       exception
 378          when others =>
 379             Report.Failed
 380                ( "Delete not properly implemented for Text_IO" );
 381       end Deletion;
 382
 383
 384    exception
 385
 386       when No_Reset =>
 387          null;
 388
 389       when Non_Applicable_System =>
 390          Report.Not_Applicable("System not capable of supporting external " &
 391                                "text files -- Name_Error/Use_Error raised " &
 392                                "during text file creation");
 393       when The_Error : others =>
 394          Report.Failed ("The following exception was raised in the " &
 395                         "Test_Block: " & Exception_Name(The_Error));
 396    end Test_Block;
 397
 398    Report.Result;
 399
 400 end CXAA017;