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

   1 -- CXA9002.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 the generic package
  28 --      Ada.Storage_IO provide the ability to store and retrieve objects
  29 --      of tagged types from in-memory buffers.
  30 --
  31 -- TEST DESCRIPTION:
  32 --      The following scenario demonstrates how objects of a tagged type,
  33 --      extended types, and twice extended types can be written/read
  34 --      to/from Direct_IO files. The Storage_IO subprograms, Read and Write,
  35 --      demonstrated in this scenario, perform tag "fixing" prior to/following
  36 --      transfer to the Direct_IO files.
  37 --      This method is especially important for those implementations that
  38 --      represent tags as pointers, or for cases where the tagged objects
  39 --      are read in by a program other than the one that wrote them.
  40 --
  41 --      In this small example, we have attempted to simulate the situation
  42 --      where two independent programs are using a series of Direct_IO files,
  43 --      one writing data to the files, and the second program reading the
  44 --      data from those files.  Two procedures are defined, the first
  45 --      simulating the program responsible for writing, the second simulating
  46 --      a separate program opening and reading the data from the files.
  47 --
  48 --      The hierarchy of types used in this test can be displayed as follows:
  49 --
  50 --                                Account_Type
  51 --                                 /       \
  52 --                                /         \
  53 --                               /           \
  54 --                  Cash_Account_Type       Investment_Account_Type
  55 --                     /         \
  56 --                    /           \
  57 --                   /             \
  58 --      Checking_Account_Type    Savings_Account_Type
  59 --
  60 -- APPLICABILITY CRITERIA:
  61 --      Applicable to implementations capable of supporting external
  62 --      Direct_IO files.
  63 --
  64 --
  65 -- CHANGE HISTORY:
  66 --      06 Dec 94   SAIC    ACVC 2.0
  67 --      08 Nov 95   SAIC    Corrected incorrect prefix of 'Tag for ACVC 2.0.1,
  68 --                          and mode of files in Procedure Read_Data.
  69 --                          Added verification of objects reconstructed from
  70 --                          files.
  71 --      27 Feb 97   PWB.CTA Allowed for non-support of some IO operations
  72 --!
  73
  74 package CXA9002_0 is
  75
  76    type Investment_Type is (Stocks, Bonds, Mutual_Funds);
  77    type Savings_Type    is (Standard, Business, Impound);
  78
  79    type Account_Type is tagged
  80       record
  81          Num : String (1..3);
  82       end record;
  83
  84    type Cash_Account_Type is new Account_Type with
  85       record
  86          Years_As_Customer : Natural := 1;
  87       end record;
  88
  89    type Investment_Account_Type is new Account_Type with
  90       record
  91          Investment_Vehicle : Investment_Type := Stocks;
  92       end record;
  93
  94    type Checking_Account_Type is new Cash_Account_Type with
  95       record
  96          Checks_Per_Year  : Positive := 200;
  97          Interest_Bearing : Boolean  := False;
  98       end record;
  99
 100    type Savings_Account_Type is new Cash_Account_Type with
 101       record
 102          Kind : Savings_Type := Standard;
 103       end record;
 104
 105 end CXA9002_0;
 106
 107 ---
 108
 109 with Report;
 110 with Ada.Storage_IO;
 111 with Ada.Direct_IO;
 112 with Ada.Tags;
 113 with CXA9002_0;
 114
 115 procedure CXA9002 is
 116    package Dir_IO is new Ada.Direct_IO (Integer);
 117    Test_File : Dir_IO.File_Type;
 118    Incomplete : exception;
 119 begin
 120
 121    Report.Test ("CXA9002", "Check that the operations defined in the "   &
 122                            "generic package Ada.Storage_IO provide the " &
 123                            "ability to store and retrieve objects of "   &
 124                            "tagged types from in-memory buffers");
 125
 126
 127    Test_For_Direct_IO_Support:
 128    begin
 129
 130       -- The following Create does not have any bearing on the test scenario,
 131       -- but is included to check that the implementation supports Direct_IO
 132       -- files.  An exception on this Create statement will raise a Name_Error
 133       -- or Use_Error, which will be handled to produce a Not_Applicable
 134       -- result. If created, the file is immediately deleted, as it is not
 135       -- needed for the program scenario.
 136
 137       Dir_IO.Create (Test_File,
 138                      Dir_IO.Out_File,
 139                      Report.Legal_File_Name(1));
 140    exception
 141
 142        when Dir_IO.Use_Error | Dir_IO.Name_Error =>
 143           Report.Not_Applicable
 144              ( "Files not supported - Create as Out_File for Direct_IO" );
 145           raise Incomplete;
 146
 147    end Test_for_Direct_IO_Support;
 148
 149    Deletion:
 150    begin
 151       Dir_IO.Delete (Test_File);
 152    exception
 153       when others =>
 154          Report.Failed
 155             ( "Delete not properly implemented for Direct_IO" );
 156    end Deletion;
 157
 158    Test_Block:
 159    declare
 160
 161       use CXA9002_0;
 162
 163       Acct_Filename : constant String := Report.Legal_File_Name(1);
 164       Cash_Filename : constant String := Report.Legal_File_Name(2);
 165       Inv_Filename  : constant String := Report.Legal_File_Name(3);
 166       Chk_Filename  : constant String := Report.Legal_File_Name(4);
 167       Sav_Filename  : constant String := Report.Legal_File_Name(5);
 168
 169       type Tag_Pointer_Type is access String;
 170
 171       TC_Account_Type_Tag,
 172       TC_Cash_Account_Type_Tag,
 173       TC_Investment_Account_Type_Tag,
 174       TC_Checking_Account_Type_Tag,
 175       TC_Savings_Account_Type_Tag    : Tag_Pointer_Type;
 176
 177       TC_Account            : Account_Type            :=
 178                                 (Num => "123");
 179
 180       TC_Cash_Account       : Cash_Account_Type       :=
 181                                 (Num               => "234",
 182                                  Years_As_Customer => 3);
 183
 184       TC_Investment_Account : Investment_Account_Type :=
 185                                 (Num                => "456",
 186                                  Investment_Vehicle => Bonds);
 187
 188       TC_Checking_Account   : Checking_Account_Type   :=
 189                                 (Num               => "567",
 190                                  Years_As_Customer => 2,
 191                                  Checks_Per_Year   => 300,
 192                                  Interest_Bearing  => True);
 193
 194       TC_Savings_Account    : Savings_Account_Type    :=
 195                                 (Num               => "789",
 196                                  Years_As_Customer => 14,
 197                                  Kind              => Business);
 198
 199       procedure Buffer_Data is
 200
 201          Account            : Account_Type            :=
 202                                 TC_Account;
 203          Cash_Account       : Cash_Account_Type       :=
 204                                 TC_Cash_Account;
 205          Investment_Account : Investment_Account_Type :=
 206                                 TC_Investment_Account;
 207          Checking_Account   : Checking_Account_Type   :=
 208                                 TC_Checking_Account;
 209          Savings_Account    : Savings_Account_Type    :=
 210                                 TC_Savings_Account;
 211
 212          -- The instantiations below are a central point in this test.
 213          -- Storage_IO is instantiated for each of the specific tagged
 214          -- type. These instantiated packages will be used to compress
 215          -- tagged objects of these various types into buffers that will
 216          -- be written to the Direct_IO files declared below.
 217
 218          package Acct_SIO is new Ada.Storage_IO (Account_Type);
 219          package Cash_SIO is new Ada.Storage_IO (Cash_Account_Type);
 220          package Inv_SIO  is new Ada.Storage_IO (Investment_Account_Type);
 221          package Chk_SIO  is new Ada.Storage_IO (Checking_Account_Type);
 222          package Sav_SIO  is new Ada.Storage_IO (Savings_Account_Type);
 223
 224          -- Direct_IO is instantiated for the buffer types defined in the
 225          -- instantiated Storage_IO packages.
 226
 227          package Acct_DIO is new Ada.Direct_IO (Acct_SIO.Buffer_Type);
 228          package Cash_DIO is new Ada.Direct_IO (Cash_SIO.Buffer_Type);
 229          package Inv_DIO  is new Ada.Direct_IO (Inv_SIO.Buffer_Type);
 230          package Chk_DIO  is new Ada.Direct_IO (Chk_SIO.Buffer_Type);
 231          package Sav_DIO  is new Ada.Direct_IO (Sav_SIO.Buffer_Type);
 232
 233          Acct_Buffer : Acct_SIO.Buffer_Type;
 234          Cash_Buffer : Cash_SIO.Buffer_Type;
 235          Inv_Buffer  : Inv_SIO.Buffer_Type;
 236          Chk_Buffer  : Chk_SIO.Buffer_Type;
 237          Sav_Buffer  : Sav_SIO.Buffer_Type;
 238
 239          Acct_File   : Acct_DIO.File_Type;
 240          Cash_File   : Cash_DIO.File_Type;
 241          Inv_File    : Inv_DIO.File_Type;
 242          Chk_File    : Chk_DIO.File_Type;
 243          Sav_File    : Sav_DIO.File_Type;
 244
 245       begin
 246
 247          Acct_DIO.Create (Acct_File, Acct_DIO.Out_File, Acct_Filename);
 248          Cash_DIO.Create (Cash_File, Cash_DIO.Out_File, Cash_Filename);
 249          Inv_DIO.Create  (Inv_File,  Inv_DIO.Out_File,  Inv_Filename);
 250          Chk_DIO.Create  (Chk_File,  Chk_DIO.Out_File,  Chk_Filename);
 251          Sav_DIO.Create  (Sav_File,  Sav_DIO.Out_File,  Sav_Filename);
 252
 253          -- Store the tag values of the objects declared above for
 254          -- comparison with tag values of objects following processing.
 255
 256          TC_Account_Type_Tag :=
 257            new String'(Ada.Tags.External_Tag(Account_Type'Tag));
 258
 259          TC_Cash_Account_Type_Tag :=
 260            new String'(Ada.Tags.External_Tag(Cash_Account_Type'Tag));
 261
 262          TC_Investment_Account_Type_Tag :=
 263            new String'(Ada.Tags.External_Tag(Investment_Account_Type'Tag));
 264
 265          TC_Checking_Account_Type_Tag :=
 266            new String'(Ada.Tags.External_Tag(Checking_Account_Type'Tag));
 267
 268          TC_Savings_Account_Type_Tag :=
 269            new String'(Ada.Tags.External_Tag(Savings_Account_Type'Tag));
 270
 271          -- Prepare tagged data for writing to the Direct_IO files using
 272          -- Storage_IO procedure to place data in buffers.
 273
 274          Acct_SIO.Write (Buffer => Acct_Buffer, Item => Account);
 275          Cash_SIO.Write (Cash_Buffer, Cash_Account);
 276          Inv_SIO.Write  (Inv_Buffer, Item => Investment_Account);
 277          Chk_SIO.Write  (Buffer => Chk_Buffer, Item => Checking_Account);
 278          Sav_SIO.Write  (Sav_Buffer, Savings_Account);
 279
 280          -- At this point, the data and associated tag values have been
 281          -- buffered by the Storage_IO procedure, and the buffered data
 282          -- can be written to the appropriate Direct_IO file.
 283
 284          Acct_DIO.Write (File => Acct_File, Item => Acct_Buffer);
 285          Cash_DIO.Write (Cash_File, Cash_Buffer);
 286          Inv_DIO.Write  (Inv_File, Item => Inv_Buffer);
 287          Chk_DIO.Write  (File => Chk_File, Item =>Chk_Buffer);
 288          Sav_DIO.Write  (Sav_File, Sav_Buffer);
 289
 290          -- Close all Direct_IO files.
 291
 292          Acct_DIO.Close (Acct_File);
 293          Cash_DIO.Close (Cash_File);
 294          Inv_DIO.Close  (Inv_File);
 295          Chk_DIO.Close  (Chk_File);
 296          Sav_DIO.Close  (Sav_File);
 297
 298       exception
 299          when others => Report.Failed("Exception raised in Buffer_Data");
 300       end Buffer_Data;
 301
 302       procedure Read_Data is
 303
 304          Account            : Account_Type;
 305          Cash_Account       : Cash_Account_Type;
 306          Investment_Account : Investment_Account_Type;
 307          Checking_Account   : Checking_Account_Type;
 308          Savings_Account    : Savings_Account_Type;
 309
 310          -- Storage_IO is instantiated for each of the specific tagged
 311          -- type.
 312
 313          package Acct_SIO is new Ada.Storage_IO (Account_Type);
 314          package Cash_SIO is new Ada.Storage_IO (Cash_Account_Type);
 315          package Inv_SIO  is new Ada.Storage_IO (Investment_Account_Type);
 316          package Chk_SIO  is new Ada.Storage_IO (Checking_Account_Type);
 317          package Sav_SIO  is new Ada.Storage_IO (Savings_Account_Type);
 318
 319          -- Direct_IO is instantiated for the buffer types defined in the
 320          -- instantiated Storage_IO packages.
 321
 322          package Acct_DIO is new Ada.Direct_IO (Acct_SIO.Buffer_Type);
 323          package Cash_DIO is new Ada.Direct_IO (Cash_SIO.Buffer_Type);
 324          package Inv_DIO  is new Ada.Direct_IO (Inv_SIO.Buffer_Type);
 325          package Chk_DIO  is new Ada.Direct_IO (Chk_SIO.Buffer_Type);
 326          package Sav_DIO  is new Ada.Direct_IO (Sav_SIO.Buffer_Type);
 327
 328          Acct_Buffer : Acct_SIO.Buffer_Type;
 329          Cash_Buffer : Cash_SIO.Buffer_Type;
 330          Inv_Buffer  : Inv_SIO.Buffer_Type;
 331          Chk_Buffer  : Chk_SIO.Buffer_Type;
 332          Sav_Buffer  : Sav_SIO.Buffer_Type;
 333
 334          Acct_File   : Acct_DIO.File_Type;
 335          Cash_File   : Cash_DIO.File_Type;
 336          Inv_File    : Inv_DIO.File_Type;
 337          Chk_File    : Chk_DIO.File_Type;
 338          Sav_File    : Sav_DIO.File_Type;
 339
 340       begin
 341
 342          -- Open the Direct_IO files.
 343
 344          Acct_DIO.Open (Acct_File, Acct_DIO.In_File, Acct_Filename);
 345          Cash_DIO.Open (Cash_File, Cash_DIO.In_File, Cash_Filename);
 346          Inv_DIO.Open  (Inv_File,  Inv_DIO.In_File,  Inv_Filename);
 347          Chk_DIO.Open  (Chk_File,  Chk_DIO.In_File,  Chk_Filename);
 348          Sav_DIO.Open  (Sav_File,  Sav_DIO.In_File,  Sav_Filename);
 349
 350          -- Read the buffer data from the files using Direct_IO.
 351
 352          Acct_DIO.Read (File => Acct_File, Item => Acct_Buffer);
 353          Cash_DIO.Read (Cash_File, Cash_Buffer);
 354          Inv_DIO.Read  (Inv_File, Item => Inv_Buffer);
 355          Chk_DIO.Read  (File => Chk_File, Item =>Chk_Buffer);
 356          Sav_DIO.Read  (Sav_File, Sav_Buffer);
 357
 358          -- At this point, the data and associated tag values are stored
 359          -- in buffers. Use the Storage_IO procedure Read to recreate the
 360          -- tagged objects from the buffers.
 361
 362          Acct_SIO.Read (Buffer => Acct_Buffer, Item => Account);
 363          Cash_SIO.Read (Cash_Buffer, Cash_Account);
 364          Inv_SIO.Read  (Inv_Buffer, Item => Investment_Account);
 365          Chk_SIO.Read  (Buffer => Chk_Buffer, Item => Checking_Account);
 366          Sav_SIO.Read  (Sav_Buffer, Savings_Account);
 367
 368          -- Delete all Direct_IO files.
 369
 370          Acct_DIO.Delete (Acct_File);
 371          Cash_DIO.Delete (Cash_File);
 372          Inv_DIO.Delete  (Inv_File);
 373          Chk_DIO.Delete  (Chk_File);
 374          Sav_DIO.Delete  (Sav_File);
 375
 376          Data_Verification_Block:
 377          begin
 378
 379             if Account /= TC_Account then
 380                Report.Failed("Incorrect Account object reconstructed");
 381             end if;
 382
 383             if Cash_Account /= TC_Cash_Account then
 384                Report.Failed
 385                  ("Incorrect Cash_Account object reconstructed");
 386             end if;
 387
 388             if Investment_Account /= TC_Investment_Account then
 389                Report.Failed
 390                  ("Incorrect Investment_Account object reconstructed");
 391             end if;
 392
 393             if Checking_Account /= TC_Checking_Account then
 394                Report.Failed
 395                  ("Incorrect Checking_Account object reconstructed");
 396             end if;
 397
 398             if Savings_Account /= TC_Savings_Account then
 399                Report.Failed
 400                  ("Incorrect Savings_Account object reconstructed");
 401             end if;
 402
 403          exception
 404             when others =>
 405               Report.Failed
 406                 ("Exception raised during Data_Verification Block");
 407          end Data_Verification_Block;
 408
 409
 410          -- To ensure that the tags of the values reconstructed by
 411          -- Storage_IO were properly preserved, object tag values following
 412          -- object reconstruction are compared with tag values of objects
 413          -- stored prior to processing.
 414
 415          Tag_Verification_Block:
 416          begin
 417
 418             if TC_Account_Type_Tag.all /=
 419                Ada.Tags.External_Tag(Account_Type'Class(Account)'Tag)
 420             then
 421                Report.Failed("Incorrect Account tag");
 422             end if;
 423
 424             if TC_Cash_Account_Type_Tag.all       /=
 425                Ada.Tags.External_Tag(
 426                  Cash_Account_Type'Class(Cash_Account)'Tag)
 427             then
 428                Report.Failed("Incorrect Cash_Account tag");
 429             end if;
 430
 431             if TC_Investment_Account_Type_Tag.all /=
 432                Ada.Tags.External_Tag(
 433                  Investment_Account_Type'Class(Investment_Account)'Tag)
 434             then
 435                Report.Failed("Incorrect Investment_Account tag");
 436             end if;
 437
 438             if TC_Checking_Account_Type_Tag.all   /=
 439                Ada.Tags.External_Tag(
 440                  Checking_Account_Type'Class(Checking_Account)'Tag)
 441             then
 442                Report.Failed("Incorrect Checking_Account tag");
 443             end if;
 444
 445             if TC_Savings_Account_Type_Tag.all    /=
 446                Ada.Tags.External_Tag(
 447                  Savings_Account_Type'Class(Savings_Account)'Tag)
 448             then
 449                Report.Failed("Incorrect Savings_Account tag");
 450             end if;
 451
 452          exception
 453             when others =>
 454               Report.Failed ("Exception raised during tag evaluation");
 455          end Tag_Verification_Block;
 456
 457       exception
 458          when others => Report.Failed ("Exception in Read_Data");
 459       end Read_Data;
 460
 461       begin  -- Test_Block
 462
 463       -- Enter the data into the appropriate files.
 464       Buffer_Data;
 465
 466       -- Reconstruct the data from files, and verify the results.
 467       Read_Data;
 468
 469    exception
 470       when others => Report.Failed ("Exception raised in Test_Block");
 471    end Test_Block;
 472
 473    Report.Result;
 474
 475 exception
 476    when Incomplete =>
 477       Report.Result;
 478    when others     =>
 479       Report.Failed ( "Unexpected exception" );
 480       Report.Result;
 481
 482 end CXA9002;