old-autovect-branch/gcc/testsuite/ada/acats/tests/cxa/cxaa018.a

   1 -- CXAA018.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 the subprograms defined in the package Text_IO.Modular_IO
  28 --      provide correct results.
  29 --
  30 -- TEST DESCRIPTION:
  31 --      This test checks that the subprograms defined in the
  32 --      Ada.Text_IO.Modular_IO package provide correct results.
  33 --      A modular type is defined and used to instantiate the generic
  34 --      package Ada.Text_IO.Modular_IO.  Values of the modular type are
  35 --      written to a Text_IO file, and to a series of string variables, using
  36 --      different versions of the procedure Put from the instantiated IO
  37 --      package.  These modular data items are retrieved from the file and
  38 --      string variables using the appropriate instantiated version of
  39 --      procedure Get.  A variety of Base and Width parameter values are
  40 --      used in the procedure calls.
  41 --
  42 -- APPLICABILITY CRITERIA:
  43 --      This test is applicable to all implementations that support Text_IO
  44 --      processing and external files.
  45 --
  46 --
  47 -- CHANGE HISTORY:
  48 --      03 Jul 95   SAIC    Initial prerelease version.
  49 --      01 May 96   SAIC    Incorporated reviewer comments for ACVC 2.1.
  50 --
  51 --!
  52
  53 with Ada.Text_IO;
  54 with System;
  55 with Report;
  56
  57 procedure CXAA018 is
  58 begin
  59
  60    Report.Test ("CXAA018", "Check that the subprograms defined in "  &
  61                            "the package Text_IO.Modular_IO provide " &
  62                            "correct results");
  63
  64    Test_for_Text_IO_Support:
  65    declare
  66       Data_File     : Ada.Text_IO.File_Type;
  67       Data_Filename : constant String := Report.Legal_File_Name;
  68    begin
  69
  70       -- An application creates a text file in mode Out_File, with the
  71       -- intention of entering modular data into the file as appropriate.
  72       -- In the event that the particular environment where the application
  73       -- is running does not support Text_IO, Use_Error or Name_Error will be
  74       -- raised on calls to Text_IO operations.  Either of these exceptions
  75       -- will be handled to produce a Not_Applicable result.
  76
  77       Ada.Text_IO.Create (File => Data_File,
  78                           Mode => Ada.Text_IO.Out_File,
  79                           Name => Data_Filename);
  80
  81       Test_Block:
  82       declare
  83
  84          type Mod_Type is mod System.Max_Binary_Modulus;
  85          -- Max_Binary_Modulus must be at least 2**16, which would result
  86          -- in a base range of 0..65535 (zero to one less than the given
  87          -- modulus) for this modular type.
  88
  89          package Mod_IO is new Ada.Text_IO.Modular_IO(Mod_Type);
  90          use Ada.Text_IO, Mod_IO;
  91          use type Mod_Type;
  92
  93          Number_Of_Modular_Items : constant := 6;
  94          Number_Of_Error_Items   : constant := 1;
  95
  96          TC_Modular              : Mod_Type;
  97          TC_Last_Character_Read  : Positive;
  98
  99          Modular_Array : array (1..Number_Of_Modular_Items) of Mod_Type :=
 100                                    ( 0, 97, 255, 1025, 12097, 65535 );
 101
 102
 103          procedure Load_File (The_File : in out Ada.Text_IO.File_Type) is
 104          begin
 105             -- This procedure does not create, open, or close the data file;
 106             -- The_File file object must be Open at this point.
 107             -- This procedure is designed to load Modular_Type data into a
 108             -- data file.
 109             --
 110             -- Use the Modular_IO procedure Put to enter modular data items
 111             -- into the data file.
 112
 113             for i in 1..Number_Of_Modular_Items loop
 114                -- Use default Base parameter of 10.
 115                Mod_IO.Put(File  => Data_File,
 116                           Item  => Modular_Array(i),
 117                           Width => 6,
 118                           Base  => Mod_IO.Default_Base);
 119             end loop;
 120
 121             -- Enter data into the file such that on the corresponding "Get"
 122             -- of this data, Data_Error must be raised.  This value is outside
 123             -- the base range of Modular_Type.
 124             -- Text_IO is used to enter the value in the file.
 125
 126             for i in 1..Number_Of_Error_Items loop
 127                Ada.Text_IO.Put(The_File, "-10");
 128             end loop;
 129
 130          end Load_File;
 131
 132
 133
 134          procedure Process_File(The_File : in out Ada.Text_IO.File_Type) is
 135          begin
 136             -- This procedure does not create, open, or close the data file;
 137             -- The_File file object must be Open at this point.
 138             -- Use procedure Get (for Files) to extract the modular data from
 139             -- the Text_IO file.
 140
 141             for i in 1..Number_Of_Modular_Items loop
 142                Mod_IO.Get(The_File, TC_Modular, Width => 6);
 143
 144                if TC_Modular /= Modular_Array(i) then
 145                   Report.Failed("Incorrect modular data read from file " &
 146                                 "data item #" & Integer'Image(i));
 147                end if;
 148             end loop;
 149
 150             -- The final item in the Data_File is a modular value that is
 151             -- outside the base range 0..Num'Last.  This value should raise
 152             -- Data_Error on an attempt to "Get" it from the file.
 153
 154             for i in 1..Number_Of_Error_Items loop
 155                begin
 156                   Mod_IO.Get(The_File, TC_Modular, Mod_IO.Default_Width);
 157                   Report.Failed
 158                     ("Exception Data_Error not raised when Get "   &
 159                      "was used to read modular data outside base " &
 160                      "range of type, item # "                      &
 161                      Integer'Image(i));
 162                exception
 163                   when Ada.Text_IO.Data_Error =>
 164                      null; -- OK, expected exception.
 165                   when others =>
 166                      Report.Failed("Unexpected exception raised when Get "  &
 167                                    "was used to read modular data outside " &
 168                                    "base range of type from Data_File, "    &
 169                                    "data item #" & Integer'Image(i));
 170                end;
 171             end loop;
 172
 173          exception
 174             when others =>
 175               Report.Failed
 176                 ("Unexpected exception raised in Process_File");
 177          end Process_File;
 178
 179
 180
 181       begin  -- Test_Block.
 182
 183          -- Place modular values into data file.
 184
 185          Load_File(Data_File);
 186          Ada.Text_IO.Close(Data_File);
 187
 188          -- Read modular values from data file.
 189
 190          Ada.Text_IO.Open(Data_File, Ada.Text_IO.In_File, Data_Filename);
 191          Process_File(Data_File);
 192
 193          -- Verify versions of Modular_IO procedures Put and Get for Strings.
 194
 195          Modular_IO_in_Strings:
 196          declare
 197             TC_String_Array : array (1..Number_Of_Modular_Items)
 198                               of String(1..30) := (others =>(others => ' '));
 199          begin
 200
 201             -- Place modular values into strings using the Procedure Put,
 202             -- Use a variety of different "Base" parameter values.
 203             -- Note: This version of Put uses the length of the given
 204             --       string as the value of the "Width" parameter.
 205
 206             for i in 1..2 loop
 207                Mod_IO.Put(To   => TC_String_Array(i),
 208                           Item => Modular_Array(i),
 209                           Base => Mod_IO.Default_Base);
 210             end loop;
 211             for i in 3..4 loop
 212                Mod_IO.Put(TC_String_Array(i),
 213                           Modular_Array(i),
 214                           Base => 2);
 215             end loop;
 216             for i in 5..6 loop
 217                Mod_IO.Put(TC_String_Array(i), Modular_Array(i), 16);
 218             end loop;
 219
 220             -- Get modular values from strings using the Procedure Get.
 221             -- Compare with expected modular values.
 222
 223             for i in 1..Number_Of_Modular_Items loop
 224
 225                Mod_IO.Get(From => TC_String_Array(i),
 226                           Item => TC_Modular,
 227                           Last => TC_Last_Character_Read);
 228
 229                if TC_Modular /= Modular_Array(i) then
 230                   Report.Failed("Incorrect modular data value obtained "   &
 231                                 "from String following use of Procedures " &
 232                                 "Put and Get from Strings, Modular_Array " &
 233                                 "item #" & Integer'Image(i));
 234                end if;
 235             end loop;
 236
 237          exception
 238             when others =>
 239                Report.Failed("Unexpected exception raised during the " &
 240                              "evaluation of Put and Get for Strings");
 241          end Modular_IO_in_Strings;
 242
 243       exception
 244          when others => Report.Failed ("Exception raised in Test_Block");
 245       end Test_Block;
 246
 247
 248       -- Delete the external file.
 249       if Ada.Text_IO.Is_Open(Data_File) then
 250          Ada.Text_IO.Delete(Data_File);
 251       else
 252          Ada.Text_IO.Open(Data_File,
 253                           Ada.Text_IO.In_File,
 254                           Data_Filename);
 255          Ada.Text_IO.Delete(Data_File);
 256       end if;
 257
 258    exception
 259
 260       -- Since Use_Error can be raised if, for the specified mode,
 261       -- the environment does not support Text_IO operations, the
 262       -- following handlers are included:
 263
 264       when Ada.Text_IO.Use_Error  =>
 265          Report.Not_Applicable ("Use_Error raised on Text_IO Create");
 266
 267       when Ada.Text_IO.Name_Error =>
 268          Report.Not_Applicable ("Name_Error raised on Text_IO Create");
 269
 270       when others                 =>
 271          Report.Failed ("Unexpected exception raised on text file Create");
 272
 273    end Test_for_Text_IO_Support;
 274
 275    Report.Result;
 276
 277 end CXAA018;