gcc/testsuite/ada/acats/tests/cxa/cxaa010.a

   1 -- CXAA010.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 operations defined in package Ada.Text_IO.Decimal_IO
  28 --      are available, and that they function correctly when used for the
  29 --      input/output of Decimal types.
  30 --
  31 -- TEST DESCRIPTION:
  32 --      This test demonstrates the Put and Get procedures found in the
  33 --      generic package Ada.Text_IO.Decimal_IO.  Both Put and Get are
  34 --      overloaded to allow placement or extraction of decimal values
  35 --      to/from a text file or a string.  This test demonstrates both forms
  36 --      of each subprogram.
  37 --      The test defines an array of records containing decimal value
  38 --      and string component fields.  All component values are placed in a
  39 --      Text_IO file, with the decimal values being placed there using the
  40 --      version of Put defined for files, and using user-specified formatting
  41 --      parameters.  The data is later extracted from the file, with the
  42 --      decimal values being removed using the version of Get defined for
  43 --      files.  Decimal values are then written to strings, using the
  44 --      appropriate Put procedure.  Finally, extraction of the decimal data
  45 --      from the strings completes the evaluation of the Decimal_IO package
  46 --      subprograms.
  47 --      The reconstructed data is verified at the end of the test against the
  48 --      data originally written to the file.
  49 --
  50 -- APPLICABILITY CRITERIA:
  51 --      Applicable to all implementations capable of supporting external
  52 --      Text_IO files and Decimal Fixed Point Types
  53 --
  54 --      All implementations must attempt to compile this test.
  55 --
  56 --      For implementations validating against Information Systems Annex (F):
  57 --        this test must execute and report PASSED.
  58 --
  59 --      For implementations not validating against Annex F:
  60 --        this test may report compile time errors at one or more points
  61 --        indicated by "-- ANX-F RQMT", in which case it may be graded as inapplicable.
  62 --        Otherwise, the test must execute and report PASSED.
  63 --
  64 --
  65 -- CHANGE HISTORY:
  66 --      06 Dec 94   SAIC    ACVC 2.0
  67 --      20 Feb 95   SAIC    Modified test to allow for Use_Error/Name_Error
  68 --                          generation by an implementation not supporting
  69 --                          Text_IO operations.
  70 --      14 Nov 95   SAIC    Corrected string indexing for ACVC 2.0.1.
  71 --      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
  72 --      16 FEB 98   EDS     Modified documentation.
  73 --!
  74
  75 with Ada.Text_IO;
  76 with Report;
  77
  78 procedure CXAA010 is
  79    use Ada.Text_IO;
  80    Tax_Roll      : Ada.Text_IO.File_Type;
  81    Tax_Roll_Name : constant String :=
  82                            Report.Legal_File_Name ( Nam => "CXAA010" );
  83    Incomplete : exception;
  84 begin
  85
  86    Report.Test ("CXAA010", "Check that the operations defined in package " &
  87                            "Ada.Text_IO.Decimal_IO are available, and "    &
  88                            "that they function correctly when used for "   &
  89                            "the input/output of Decimal types");
  90
  91    Test_for_Decimal_IO_Support:
  92    begin
  93
  94       -- An implementation that does not support Text_IO creation or naming
  95       -- of external files in a particular environment will raise Use_Error
  96       -- or Name_Error on a call to Text_IO Create. This block statement
  97       -- encloses a call to Create, which should produce an exception in a
  98       -- non-supportive environment.  Either of these exceptions will be
  99       -- handled to produce a Not_Applicable result.
 100
 101       Ada.Text_IO.Create (Tax_Roll, Ada.Text_IO.Out_File, Tax_Roll_Name);
 102
 103    exception
 104
 105        when Ada.Text_IO.Use_Error | Ada.Text_IO.Name_Error =>
 106           Report.Not_Applicable
 107              ( "Files not supported - Create as Out_File for Text_IO" );
 108           raise Incomplete;
 109
 110    end Test_for_Decimal_IO_Support;
 111
 112    Taxation:
 113    declare
 114
 115       ID_Length           : constant :=  5;
 116       Price_String_Length : constant :=  5;
 117       Value_String_Length : constant :=  6;
 118       Total_String_Length : constant := 20;
 119       Spacer              : constant String := "  ";  -- Two blanks.
 120
 121       type Price_Type     is delta 0.1  digits 4;              -- ANX-F RQMT
 122       type Value_Type     is delta 0.01 digits 5;              -- ANX-F RQMT
 123
 124       type Property_Type  is
 125          record
 126             Parcel_ID      : String (1..ID_Length);
 127             Purchase_Price : Price_Type;
 128             Assessed_Value : Value_Type;
 129          end record;
 130
 131       type    City_Block_Type     is array (1..4) of Property_Type;
 132
 133       subtype Tax_Bill_Type       is string (1..Total_String_Length);
 134       type    Tax_Bill_Array_Type is array (1..4) of Tax_Bill_Type;
 135
 136       Neighborhood : City_Block_Type :=
 137         (("X9254", 123.0, 135.00), ("X3569", 345.0, 140.50),
 138          ("X3434", 234.0, 179.50), ("X8838", 456.0, 158.00));
 139
 140       Neighborhood_Taxes : Tax_Bill_Array_Type;
 141
 142       package Price_IO is new Ada.Text_IO.Decimal_IO (Price_Type);
 143       package Value_IO is new Ada.Text_IO.Decimal_IO (Value_Type);
 144
 145    begin  -- Taxation
 146
 147       Assessors_Office:
 148       begin
 149
 150          for Parcel in City_Block_Type'Range loop
 151             -- Note: All data in the file will be separated with a
 152             --       two-character blank spacer.
 153             Ada.Text_IO.Put(Tax_Roll, Neighborhood(Parcel).Parcel_ID);
 154             Ada.Text_IO.Put(Tax_Roll, Spacer);
 155
 156             -- Use Decimal_IO.Put with non-default format parameters to
 157             -- place decimal data into file.
 158             Price_IO.Put   (Tax_Roll, Neighborhood(Parcel).Purchase_Price,
 159                             Fore => 3, Aft =>1, Exp => 0);
 160             Ada.Text_IO.Put(Tax_Roll, Spacer);
 161
 162             Value_IO.Put   (Tax_Roll, Neighborhood(Parcel).Assessed_Value,
 163                             Fore => 3, Aft =>2, Exp => 0);
 164             Ada.Text_IO.New_Line(Tax_Roll);
 165          end loop;
 166
 167          Ada.Text_IO.Close (Tax_Roll);
 168
 169       exception
 170          when others =>
 171             Report.Failed ("Exception raised in Assessor's Office");
 172       end Assessors_Office;
 173
 174
 175       Twice_A_Year:
 176       declare
 177
 178          procedure Collect_Tax(Index     : in     Integer;
 179                                Tax_Array : in out Tax_Bill_Array_Type) is
 180             ID            : String (1..ID_Length);
 181             Price         : Price_Type := 0.0;
 182             Value         : Value_Type := 0.00;
 183             Price_String  : String (1..Price_String_Length);
 184             Value_String  : String (1..Value_String_Length);
 185          begin
 186
 187             -- Extract information from the Text_IO file; one string, two
 188             -- decimal values.
 189             -- Note that the Spacers that were put in the file above are
 190             -- not individually read here, due to the fact that each call
 191             -- to Decimal_IO.Get below uses a zero in the Width field,
 192             -- which allows each Get procedure to skip these leading blanks
 193             -- prior to extracting the numeric value.
 194
 195             Ada.Text_IO.Get (Tax_Roll, ID);
 196
 197             -- A zero value of Width is provided, so the following
 198             -- two calls to Decimal_IO.Get will skip the leading blanks,
 199             -- (from the Spacer variable above), then read the numeric
 200             -- literals.
 201
 202             Price_IO.Get    (Tax_Roll, Price, 0);
 203             Value_IO.Get    (Tax_Roll, Value, 0);
 204             Ada.Text_IO.Skip_Line (Tax_Roll);
 205
 206             -- Convert the values read from the file into string format,
 207             -- using user-specified format parameters.
 208             -- Format of the Price_String should be "nnn.n"
 209             -- Format of the Value_String should be "nnn.nn"
 210
 211             Price_IO.Put (To   => Price_String,
 212                           Item => Price,
 213                           Aft  => 1);
 214             Value_IO.Put (Value_String, Value, 2);
 215
 216             -- Construct a string of length 20 that contains the Parcel_ID,
 217             -- the Purchase_Price, and the Assessed_Value, separated by
 218             -- two-character blank data spacers.  Store this string
 219             -- into the string array out parameter.
 220             -- Format of each Tax_Array element should be
 221             -- "Xnnnn  nnn.n  nnn.nn" (with an 'n' signifying a digit).
 222
 223             Tax_Array(Index) := ID           & Spacer &
 224                                 Price_String & Spacer &
 225                                 Value_String;
 226          exception
 227             when Data_Error =>
 228                Report.Failed("Data Error raised during the extraction " &
 229                              "of decimal data from the file");
 230             when others     =>
 231               Report.Failed("Exception in Collect_Tax procedure");
 232          end Collect_Tax;
 233
 234
 235       begin  -- Twice_A_Year
 236
 237          Ada.Text_IO.Open (Tax_Roll, Ada.Text_IO.In_File, Tax_Roll_Name);
 238
 239          -- Determine property tax bills for the entire neighborhood from
 240          -- the information that is stored in the file. Store information
 241          -- in the Neighborhood_Taxes string array.
 242
 243          for Parcel in City_Block_Type'Range loop
 244             Collect_Tax (Parcel, Neighborhood_Taxes);
 245          end loop;
 246
 247       exception
 248          when others =>
 249            Report.Failed ("Exception in Twice_A_Year Block");
 250       end Twice_A_Year;
 251
 252       -- Use Decimal_IO Get procedure to extract information from a string.
 253       -- Verify data against original values.
 254       Validation_Block:
 255       declare
 256          TC_ID     : String (1..ID_Length);    -- 1..5
 257          TC_Price  : Price_Type;
 258          TC_Value  : Value_Type;
 259          Length    : Positive;
 260          Front,
 261          Rear      : Integer := 0;
 262       begin
 263
 264          for Parcel in City_Block_Type'Range loop
 265             -- Extract values from the strings of the string array.
 266             -- Each element of the string array is 20 characters long; the
 267             -- first five characters are the Parcel_ID, two blank characters
 268             -- separate data, the next five characters contain the Price
 269             -- decimal value, two blank characters separate data, the last
 270             -- six characters contain the Value decimal value.
 271             -- Extract each of these components in turn.
 272
 273             Front := 1;                                        --  1
 274             Rear  := ID_Length;                                --  5
 275             TC_ID := Neighborhood_Taxes(Parcel)(Front..Rear);
 276
 277             -- Extract the decimal value from the next slice of the string.
 278             Front := Rear + 3;                                 --  8
 279             Rear  := Front + Price_String_Length - 1;          -- 12
 280             Price_IO.Get (Neighborhood_Taxes(Parcel)(Front..Rear),
 281                           Item => TC_Price,
 282                           Last => Length);
 283
 284             -- Extract next decimal value from slice of string, based on
 285             -- length of preceding strings read from string array element.
 286             Front := Rear + 3;                                 -- 15
 287             Rear  := Total_String_Length;                      -- 20
 288             Value_IO.Get (Neighborhood_Taxes(Parcel)(Front..Rear),
 289                           Item => TC_Value,
 290                           Last => Length);
 291
 292             if TC_ID    /= Neighborhood(Parcel).Parcel_ID       or
 293                TC_Price /= Neighborhood(Parcel).Purchase_Price  or
 294                TC_Value /= Neighborhood(Parcel).Assessed_Value
 295             then
 296                Report.Failed ("Incorrect data validation");
 297             end if;
 298
 299          end loop;
 300
 301       exception
 302          when others => Report.Failed ("Exception in Validation Block");
 303       end Validation_Block;
 304
 305       -- Check that the Text_IO file is open, then delete.
 306
 307       if not Ada.Text_IO.Is_Open (Tax_Roll) then
 308          Report.Failed ("File not left open after processing");
 309          Ada.Text_IO.Open (Tax_Roll, Ada.Text_IO.Out_File, Tax_Roll_Name);
 310       end if;
 311
 312       Ada.Text_IO.Delete (Tax_Roll);
 313
 314    exception
 315       when others =>
 316          Report.Failed ("Exception in Taxation block");
 317          -- Check that the Text_IO file is open, then delete.
 318          if not Ada.Text_IO.Is_Open (Tax_Roll) then
 319             Ada.Text_IO.Open (Tax_Roll,
 320                               Ada.Text_IO.Out_File,
 321                               Tax_Roll_Name);
 322          end if;
 323          Ada.Text_IO.Delete (Tax_Roll);
 324    end Taxation;
 325
 326    Report.Result;
 327
 328 exception
 329    when Incomplete =>
 330       Report.Result;
 331    when others     =>
 332       Report.Failed ( "Unexpected exception" );
 333       Report.Result;
 334
 335 end CXAA010;