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

   1 -- CXACB01.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 default attributes 'Input and 'Output work properly when
  28 --      used with objects of a variety of types, including two-dimensional
  29 --      arrays and records without default discriminants.
  30 --
  31 -- TEST DESCRIPTION:
  32 --      This test simulates utility company service record storage, using
  33 --      Stream_IO to allow the storage of heterogeneous data in a single
  34 --      stream file.
  35 --
  36 --      Three types of data are written to the stream file for each utility
  37 --      service customer.
  38 --      First, the general information on the customer is written.
  39 --      This is an object of a discriminated (without default) record
  40 --      type.  This is followed by an integer object containing a count of
  41 --      the number of service months for the customer. Finally, a
  42 --      two-dimensional array object with monthly consumption information for
  43 --      the customer is written to the stream.
  44 --
  45 --      Objects of record types with discriminants without defaults should
  46 --      have their discriminants included in the stream when using 'Output.
  47 --      Likewise, discriminants should be extracted
  48 --      from the stream when using 'Input. Similarly, array bounds are written
  49 --      to and read from the stream when using 'Output and 'Input with array
  50 --      objects.
  51 --
  52 -- APPLICABILITY CRITERIA:
  53 --      Applicable to all implementations that support external
  54 --      Stream_IO files.
  55 --
  56 --
  57 -- CHANGE HISTORY:
  58 --      06 Dec 94   SAIC    ACVC 2.0
  59 --
  60 --!
  61
  62 with FXACB00;
  63 with Ada.Streams.Stream_IO;
  64 with Report;
  65
  66 procedure CXACB01 is
  67 begin
  68
  69    Report.Test ("CXACB01", "Check that the default attributes 'Input and " &
  70                            "'Output work properly when used with objects " &
  71                            "of record, natural, and array types" );
  72
  73    Test_for_Stream_IO_Support:
  74    declare
  75
  76       Util_File                : Ada.Streams.Stream_IO.File_Type;
  77       Util_Stream              : Ada.Streams.Stream_IO.Stream_Access;
  78       Utility_Service_Filename : constant String := Report.Legal_File_Name;
  79
  80    begin
  81
  82       -- If an implementation does not support Stream_IO in a particular
  83       -- environment, the exception Use_Error or Name_Error will be raised on
  84       -- calls to various Stream_IO operations.  This block statement
  85       -- encloses a call to Create, which should produce an exception in a
  86       -- non-supportive environment.  These exceptions will be handled to
  87       -- produce a Not_Applicable result.
  88
  89       Ada.Streams.Stream_IO.Create (Util_File,
  90                                     Ada.Streams.Stream_IO.Out_File,
  91                                     Utility_Service_Filename);
  92
  93       Operational_Test_Block:
  94       declare
  95
  96          -- The following procedure will store all of the customer specific
  97          -- information into the stream.
  98
  99          procedure Store_Data_In_Stream
 100            (Customer : in FXACB00.Service_Type;
 101             Months   : in FXACB00.Months_In_Service_Type;
 102             History  : in FXACB00.Service_History_Type) is
 103          begin
 104             FXACB00.Service_Type'Output           (Util_Stream, Customer);
 105             FXACB00.Months_In_Service_Type'Output (Util_Stream, Months);
 106             FXACB00.Service_History_Type'Output   (Util_Stream, History);
 107          end Store_Data_In_Stream;
 108
 109
 110          -- The following procedure will remove from the stream all of the
 111          -- customer related information.
 112
 113          procedure Retrieve_Data_From_Stream
 114            (Customer : out FXACB00.Service_Type;
 115             Months   : out FXACB00.Months_In_Service_Type;
 116             History  : out FXACB00.Service_History_Type) is
 117          begin
 118             Customer := FXACB00.Service_Type'Input           (Util_Stream);
 119             Months   := FXACB00.Months_In_Service_Type'Input (Util_Stream);
 120             History  := FXACB00.Service_History_Type'Input   (Util_Stream);
 121          end Retrieve_Data_From_Stream;
 122
 123
 124       begin
 125
 126          Util_Stream := Ada.Streams.Stream_IO.Stream (Util_File);
 127
 128          -- Write all of the customer service information (record, numeric,
 129          -- and array objects) defined in package FXACB00 into the stream.
 130
 131          Data_Storage_Block:
 132          begin
 133
 134             Store_Data_In_Stream (Customer => FXACB00.Customer1,
 135                                   Months   => FXACB00.C1_Months,
 136                                   History  => FXACB00.C1_Service_History);
 137
 138             Store_Data_In_Stream (FXACB00.Customer2,
 139                                   FXACB00.C2_Months,
 140                                   History  => FXACB00.C2_Service_History);
 141
 142             Store_Data_In_Stream (Months   => FXACB00.C3_Months,
 143                                   History  => FXACB00.C3_Service_History,
 144                                   Customer => FXACB00.Customer3);
 145          end Data_Storage_Block;
 146
 147
 148          Data_Verification_Block:
 149          declare
 150
 151             TC_Residence  : FXACB00.Service_Type (FXACB00.Residence);
 152             TC_Apartment  : FXACB00.Service_Type (FXACB00.Apartment);
 153             TC_Commercial : FXACB00.Service_Type (FXACB00.Commercial);
 154
 155
 156             TC_Months1,
 157             TC_Months2,
 158             TC_Months3    : FXACB00.Months_In_Service_Type :=
 159                               FXACB00.Months_In_Service_Type'First;
 160
 161
 162             TC_History1   :
 163               FXACB00.Service_History_Type (FXACB00.Quarterly_Period_Type,
 164                                             FXACB00.Month_In_Quarter_Type) :=
 165               (others => (others => FXACB00.Electric_Usage_Type'Last));
 166
 167             TC_History2   :
 168               FXACB00.Service_History_Type
 169                 (FXACB00.Quarterly_Period_Type range
 170                    FXACB00.Spring .. FXACB00.Summer,
 171                  FXACB00.Month_In_Quarter_Type) :=
 172               (others => (others => FXACB00.Electric_Usage_Type'Last));
 173
 174             TC_History3   :
 175               FXACB00.Service_History_Type (FXACB00.Quarterly_Period_Type,
 176                                             FXACB00.Month_In_Quarter_Type) :=
 177               (others => (others => FXACB00.Electric_Usage_Type'Last));
 178
 179          begin
 180
 181             Ada.Streams.Stream_IO.Reset (Util_File,
 182                                          Ada.Streams.Stream_IO.In_File);
 183
 184             -- Input all of the data that is contained in the stream.
 185             -- Compare all data with the original data in package FXACB00
 186             -- that was written to the stream.
 187
 188             Retrieve_Data_From_Stream (TC_Residence, TC_Months1, TC_History1);
 189             Retrieve_Data_From_Stream (TC_Apartment, TC_Months2, TC_History2);
 190             Retrieve_Data_From_Stream (Customer => TC_Commercial,
 191                                        Months   => TC_Months3,
 192                                        History  => TC_History3);
 193
 194             -- After all the data has been correctly extracted, the file
 195             -- should be empty.
 196
 197             if not Ada.Streams.Stream_IO.End_Of_File (Util_File) then
 198                Report.Failed ("Stream file not empty");
 199             end if;
 200
 201             -- Verify that the data values read from the stream are the same
 202             -- as those written to the stream.
 203
 204             if ((FXACB00."/="(FXACB00.Customer1, TC_Residence)) or else
 205                 (FXACB00."/="(FXACB00.Customer2, TC_Apartment)) or else
 206                 (FXACB00."/="(FXACB00.Customer3, TC_Commercial)))
 207             then
 208                Report.Failed ("Customer information incorrect");
 209             end if;
 210
 211             if ((FXACB00."/="(FXACB00.C1_Months, TC_Months1)) or
 212                 (FXACB00."/="(FXACB00.C2_Months, TC_Months2)) or
 213                 (FXACB00."/="(FXACB00.C3_Months, TC_Months3)))
 214             then
 215                Report.Failed ("Number of Months information incorrect");
 216             end if;
 217
 218             if not ((FXACB00."="(FXACB00.C1_Service_History, TC_History1)) and
 219                     (FXACB00."="(FXACB00.C2_Service_History, TC_History2)) and
 220                     (FXACB00."="(FXACB00.C3_Service_History, TC_History3)))
 221             then
 222                Report.Failed ("Service history information incorrect");
 223             end if;
 224
 225          end Data_Verification_Block;
 226
 227       exception
 228
 229          when others =>
 230             Report.Failed ("Exception raised in Operational Test Block");
 231
 232       end Operational_Test_Block;
 233
 234       -- Delete the file.
 235       if Ada.Streams.Stream_IO.Is_Open (Util_File) then
 236          Ada.Streams.Stream_IO.Delete (Util_File);
 237       else
 238          Ada.Streams.Stream_IO.Open (Util_File,
 239                                      Ada.Streams.Stream_IO.Out_File,
 240                                      Utility_Service_Filename);
 241          Ada.Streams.Stream_IO.Delete (Util_File);
 242       end if;
 243
 244
 245    exception
 246
 247       -- Since Use_Error or Name_Error can be raised if, for the specified
 248       -- mode, the environment does not support Stream_IO operations,
 249       -- the following handlers are included:
 250
 251       when Ada.Streams.Stream_IO.Name_Error =>
 252          Report.Not_Applicable ("Name_Error raised on Stream IO Create");
 253
 254       when Ada.Streams.Stream_IO.Use_Error  =>
 255          Report.Not_Applicable ("Use_Error raised on Stream IO Create");
 256
 257       when others                           =>
 258          Report.Failed ("Unexpected exception raised");
 259
 260    end Test_for_Stream_IO_Support;
 261
 262    Report.Result;
 263
 264 end CXACB01;