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

   1 -- CXACA02.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 user defined subprograms can override the default
  28 --      attributes 'Read and 'Write using attribute definition clauses.
  29 --      Use objects of record types.
  30 --
  31 -- TEST DESCRIPTION:
  32 --      This test demonstrates that the default implementations of the
  33 --      'Read and 'Write attributes can be overridden by user specified
  34 --      subprograms in conjunction with attribute definition clauses.
  35 --      These attributes have been overridden below, and in the user defined
  36 --      substitutes, values are added or subtracted to global variables.
  37 --      The global variables are evaluated to ensure that the user defined
  38 --      subprograms were used in overriding the type-related default
  39 --      attributes.
  40 --
  41 -- APPLICABILITY CRITERIA:
  42 --      Applicable to all implementations that support external
  43 --      Stream_IO files.
  44 --
  45 --
  46 -- CHANGE HISTORY:
  47 --      06 Dec 94   SAIC    ACVC 2.0
  48 --      21 Nov 95   SAIC    Corrected recursive attribute definitions
  49 --                          for ACVC 2.0.1.
  50 --      24 Aug 96   SAIC    Corrected typo in test verification criteria.
  51 --
  52 --!
  53
  54 with Report;
  55 with Ada.Streams.Stream_IO;
  56
  57 procedure CXACA02 is
  58 begin
  59
  60    Report.Test ("CXACA02", "Check that user defined subprograms can "   &
  61                            "override the default attributes 'Read and " &
  62                            "'Write using attribute definition clauses");
  63
  64    Test_for_Stream_IO_Support:
  65    declare
  66
  67       Data_File      : Ada.Streams.Stream_IO.File_Type;
  68       Data_Stream    : Ada.Streams.Stream_IO.Stream_Access;
  69       The_Filename   : constant String := Report.Legal_File_Name;
  70
  71    begin
  72
  73       -- If an implementation does not support Stream_IO in a particular
  74       -- environment, the exception Use_Error or Name_Error will be raised on
  75       -- calls to various Stream_IO operations.  This block statement
  76       -- encloses a call to Create, which should produce an exception in a
  77       -- non-supportive environment.  These exceptions will be handled to
  78       -- produce a Not_Applicable result.
  79
  80       Ada.Streams.Stream_IO.Create (Data_File,
  81                                     Ada.Streams.Stream_IO.Out_File,
  82                                     The_Filename);
  83
  84       Operational_Test_Block:
  85       declare
  86
  87          type Origin_Type is (Foreign, Domestic);
  88          subtype String_Data_Type is String(1..8);
  89
  90          type Product_Type is
  91             record
  92                Item        : String_Data_Type;
  93                ID          : Natural range 1..100;
  94                Manufacture : Origin_Type := Domestic;
  95                Distributor : String_Data_Type;
  96                Importer    : String_Data_Type;
  97             end record;
  98
  99          type Sales_Record_Type is
 100             record
 101                Name              : String_Data_Type;
 102                Sale_Item         : Boolean := False;
 103                Buyer             : Origin_Type;
 104                Quantity_Discount : Boolean;
 105                Cash_Discount     : Boolean;
 106             end record;
 107
 108
 109          -- Mode conformant, user defined subprograms that will override
 110          -- the type-related attributes.
 111          -- In this test, the user defines these subprograms to add/subtract
 112          -- specific values from global variables.
 113
 114          procedure Product_Read
 115            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
 116              The_Item : out Product_Type );
 117
 118          procedure Product_Write
 119            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
 120              The_Item : Product_Type );
 121
 122          procedure Sales_Read
 123            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
 124              The_Item : out Sales_Record_Type );
 125
 126          procedure Sales_Write
 127            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
 128              The_Item : Sales_Record_Type );
 129
 130          -- Attribute definition clauses.
 131
 132          for Product_Type'Read  use Product_Read;
 133          for Product_Type'Write use Product_Write;
 134
 135          for Sales_Record_Type'Read  use Sales_Read;
 136          for Sales_Record_Type'Write use Sales_Write;
 137
 138
 139          -- Object Declarations
 140
 141          Product_01 : Product_Type :=
 142            ("Product1", 1, Domestic, "Distrib1", "Import 1");
 143          Product_02 : Product_Type :=
 144            ("Product2", 2, Foreign,  "Distrib2", "Import 2");
 145
 146          Sale_Rec_01 : Sales_Record_Type :=
 147            ("Buyer 01", False, Domestic, True, True);
 148          Sale_Rec_02 : Sales_Record_Type :=
 149            ("Buyer 02", True,  Domestic, True, False);
 150          Sale_Rec_03 : Sales_Record_Type := (Name              => "Buyer 03",
 151                                              Sale_Item         => True,
 152                                              Buyer             => Foreign,
 153                                              Quantity_Discount => False,
 154                                              Cash_Discount     => True);
 155          Sale_Rec_04 : Sales_Record_Type :=
 156            ("Buyer 04", True,  Foreign,  False, False);
 157          Sale_Rec_05 : Sales_Record_Type :=
 158            ("Buyer 05", False, Foreign,  False, False);
 159
 160          TC_Read_Total  : Integer := 100;
 161          TC_Write_Total : Integer :=   0;
 162
 163
 164          -- Subprogram bodies.
 165          -- These subprograms are designed to override the default attributes
 166          -- 'Read and 'Write for the specified types.  Each adds/subtracts
 167          -- a quantity to/from a program control variable, indicating its
 168          -- activity.   In addition, each component of the record is
 169          -- individually read from or written to the stream, using the
 170          -- appropriate 'Read or 'Write attribute for the component type.
 171          -- The string components are moved to/from the stream using the
 172          -- 'Input and 'Output attributes for the string subtype, so that
 173          -- the bounds of the strings are also written/read.
 174
 175          procedure Product_Read
 176            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
 177              The_Item : out Product_Type ) is
 178          begin
 179             TC_Read_Total := TC_Read_Total - 10;
 180
 181             The_Item.Item := String_Data_Type'Input(Data_Stream); -- Field 1.
 182             Natural'Read(Data_Stream, The_Item.ID);               -- Field 2.
 183             Origin_Type'Read(Data_Stream,                         -- Field 3.
 184                              The_Item.Manufacture);
 185             The_Item.Distributor :=                               -- Field 4.
 186               String_Data_Type'Input(Data_Stream);
 187             The_Item.Importer    :=                               -- Field 5.
 188               String_Data_Type'Input(Data_Stream);
 189          end Product_Read;
 190
 191
 192          procedure Product_Write
 193            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
 194              The_Item : Product_Type ) is
 195          begin
 196             TC_Write_Total := TC_Write_Total + 5;
 197
 198             String_Data_Type'Output(Data_Stream, The_Item.Item);  -- Field 1.
 199             Natural'Write(Data_Stream, The_Item.ID);              -- Field 2.
 200             Origin_Type'Write(Data_Stream,                        -- Field 3.
 201                              The_Item.Manufacture);
 202             String_Data_Type'Output(Data_Stream,                  -- Field 4.
 203                                     The_Item.Distributor);
 204             String_Data_Type'Output(Data_Stream,                  -- Field 5.
 205                                     The_Item.Importer);
 206          end Product_Write;
 207
 208
 209          procedure Sales_Read
 210            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
 211              The_Item : out Sales_Record_Type ) is
 212          begin
 213             TC_Read_Total := TC_Read_Total - 20;
 214
 215             The_Item.Name := String_Data_Type'Input(Data_Stream);  -- Field 1.
 216             Boolean'Read(Data_Stream, The_Item.Sale_Item);         -- Field 2.
 217             Origin_Type'Read(Data_Stream, The_Item.Buyer);         -- Field 3.
 218             Boolean'Read(Data_Stream, The_Item.Quantity_Discount); -- Field 4.
 219             Boolean'Read(Data_Stream, The_Item.Cash_Discount);     -- Field 5.
 220          end Sales_Read;
 221
 222
 223          procedure Sales_Write
 224            ( Stream   : access Ada.Streams.Root_Stream_Type'Class;
 225              The_Item : Sales_Record_Type ) is
 226          begin
 227             TC_Write_Total := TC_Write_Total + 10;
 228
 229             String_Data_Type'Output(Data_Stream, The_Item.Name);    -- Field 1.
 230             Boolean'Write(Data_Stream, The_Item.Sale_Item);         -- Field 2.
 231             Origin_Type'Write(Data_Stream, The_Item.Buyer);         -- Field 3.
 232             Boolean'Write(Data_Stream, The_Item.Quantity_Discount); -- Field 4.
 233             Boolean'Write(Data_Stream, The_Item.Cash_Discount);     -- Field 5.
 234          end Sales_Write;
 235
 236
 237
 238       begin
 239
 240          Data_Stream := Ada.Streams.Stream_IO.Stream (Data_File);
 241
 242          -- Write product and sales data to the stream.
 243
 244          Product_Type'Write      (Data_Stream, Product_01);
 245          Sales_Record_Type'Write (Data_Stream, Sale_Rec_01);
 246          Sales_Record_Type'Write (Data_Stream, Sale_Rec_02);
 247
 248          Product_Type'Write      (Data_Stream, Product_02);
 249          Sales_Record_Type'Write (Data_Stream, Sale_Rec_03);
 250          Sales_Record_Type'Write (Data_Stream, Sale_Rec_04);
 251          Sales_Record_Type'Write (Data_Stream, Sale_Rec_05);
 252
 253          -- Read data from the stream, and verify the use of the user specified
 254          -- attributes.
 255
 256          Verify_Data_Block:
 257          declare
 258
 259             TC_Product1,
 260             TC_Product2 : Product_Type;
 261
 262             TC_Sale1,
 263             TC_Sale2,
 264             TC_Sale3,
 265             TC_Sale4,
 266             TC_Sale5    : Sales_Record_Type;
 267
 268          begin
 269
 270             -- Reset the mode of the stream file so that Read/Input
 271             -- operations may be performed.
 272
 273             Ada.Streams.Stream_IO.Reset (Data_File,
 274                                          Ada.Streams.Stream_IO.In_File);
 275
 276             -- Data is read/reconstructed from the stream, in the order that
 277             -- the data was placed into the stream.
 278
 279             Product_Type'Read      (Data_Stream, TC_Product1);
 280             Sales_Record_Type'Read (Data_Stream, TC_Sale1);
 281             Sales_Record_Type'Read (Data_Stream, TC_Sale2);
 282
 283             Product_Type'Read      (Data_Stream, TC_Product2);
 284             Sales_Record_Type'Read (Data_Stream, TC_Sale3);
 285             Sales_Record_Type'Read (Data_Stream, TC_Sale4);
 286             Sales_Record_Type'Read (Data_Stream, TC_Sale5);
 287
 288             -- Verify product data was correctly written to/read from stream.
 289
 290             if TC_Product1 /= Product_01 then
 291                Report.Failed ("Data verification error, Product 1");
 292             end if;
 293             if TC_Product2 /= Product_02 then
 294                Report.Failed ("Data verification error, Product 2");
 295             end if;
 296
 297             if TC_Sale1 /= Sale_Rec_01 then
 298                Report.Failed ("Data verification error, Sale_Rec_01");
 299             end if;
 300             if TC_Sale2 /= Sale_Rec_02 then
 301                Report.Failed ("Data verification error, Sale_Rec_02");
 302             end if;
 303             if TC_Sale3 /= Sale_Rec_03 then
 304                Report.Failed ("Data verification error, Sale_Rec_03");
 305             end if;
 306             if TC_Sale4 /= Sale_Rec_04 then
 307                Report.Failed ("Data verification error, Sale_Rec_04");
 308             end if;
 309             if TC_Sale5 /= Sale_Rec_05 then
 310                Report.Failed ("Data verification error, Sale_Rec_05");
 311             end if;
 312
 313             -- Verify that the user defined subprograms were used to
 314             -- override the default 'Read and 'Write attributes.
 315             -- There were two "product" reads and two writes; there
 316             -- were five "sale record" reads and five writes.
 317
 318             if (TC_Read_Total /= -20) or (TC_Write_Total /= 60) then
 319                Report.Failed ("Incorrect use of user defined attributes");
 320             end if;
 321
 322          end Verify_Data_Block;
 323
 324       exception
 325
 326          when others =>
 327             Report.Failed ("Exception raised in Operational Test Block");
 328
 329       end Operational_Test_Block;
 330
 331       if Ada.Streams.Stream_IO.Is_Open (Data_File) then
 332          Ada.Streams.Stream_IO.Delete (Data_File);
 333       else
 334          Ada.Streams.Stream_IO.Open (Data_File,
 335                                      Ada.Streams.Stream_IO.Out_File,
 336                                      The_Filename);
 337          Ada.Streams.Stream_IO.Delete (Data_File);
 338       end if;
 339
 340
 341    exception
 342
 343       -- Since Use_Error or Name_Error can be raised if, for the specified
 344       -- mode, the environment does not support Stream_IO operations,
 345       -- the following handlers are included:
 346
 347       when Ada.Streams.Stream_IO.Name_Error =>
 348          Report.Not_Applicable ("Name_Error raised on Stream IO Create");
 349
 350       when Ada.Streams.Stream_IO.Use_Error  =>
 351          Report.Not_Applicable ("Use_Error raised on Stream IO Create");
 352
 353       when others                           =>
 354          Report.Failed ("Unexpected exception raised");
 355
 356    end Test_for_Stream_IO_Support;
 357
 358    Report.Result;
 359
 360 end CXACA02;