old-autovect-branch/gcc/testsuite/ada/acats/tests/cd/cd2b11f.ada

   1 -- CD2B11F.ADA
   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 -- OBJECTIVE:
  26 --     CHECK THAT IF A COLLECTION SIZE SPECIFICATION IS GIVEN FOR AN
  27 --     ACCESS TYPE WHOSE DESIGNATED TYPE IS A DISCRIMINATED RECORD, THEN
  28 --     OPERATIONS ON VALUES OF THE ACCESS TYPE ARE NOT AFFECTED.
  29
  30 -- HISTORY:
  31 --     BCB 09/29/87  CREATED ORIGINAL TEST.
  32 --     PWB 05/11/89  CHANGED EXTENSION FROM '.DEP' TO '.ADA'.
  33
  34 WITH REPORT;  USE REPORT;
  35
  36 PROCEDURE CD2B11F IS
  37
  38      BASIC_SIZE : CONSTANT := 1024;
  39
  40      TYPE RECORD_TYPE(DISC : INTEGER := 100) IS RECORD
  41           COMP1 : INTEGER;
  42           COMP2 : INTEGER;
  43           COMP3 : INTEGER;
  44      END RECORD;
  45
  46      TYPE ACC_RECORD IS ACCESS RECORD_TYPE;
  47      FOR ACC_RECORD'STORAGE_SIZE USE BASIC_SIZE;
  48
  49      CHECK_RECORD1 : ACC_RECORD;
  50      CHECK_RECORD2 : ACC_RECORD;
  51
  52 BEGIN
  53
  54      TEST ("CD2B11F", "CHECK THAT IF A COLLECTION SIZE SPECIFICATION " &
  55                       "IS GIVEN FOR AN ACCESS TYPE WHOSE " &
  56                       "DESIGNATED TYPE IS A DISCRIMINATED RECORD, " &
  57                       "THEN OPERATIONS ON VALUES OF THE ACCESS TYPE " &
  58                       "ARE NOT AFFECTED");
  59
  60      CHECK_RECORD1 := NEW RECORD_TYPE;
  61      CHECK_RECORD1.COMP1 := 25;
  62      CHECK_RECORD1.COMP2 := 25;
  63      CHECK_RECORD1.COMP3 := 150;
  64
  65      IF ACC_RECORD'STORAGE_SIZE < BASIC_SIZE THEN
  66           FAILED ("INCORRECT VALUE FOR RECORD TYPE ACCESS " &
  67                   "STORAGE_SIZE");
  68      END IF;
  69
  70      IF CHECK_RECORD1.DISC /= IDENT_INT (100) THEN
  71           FAILED ("INCORRECT VALUE FOR RECORD DISCRIMINANT");
  72      END IF;
  73
  74      IF ((CHECK_RECORD1.COMP1 /= CHECK_RECORD1.COMP2) OR
  75              (CHECK_RECORD1.COMP1 = CHECK_RECORD1.COMP3)) THEN
  76           FAILED ("INCORRECT VALUE FOR RECORD COMPONENT");
  77      END IF;
  78
  79      IF EQUAL (3,3) THEN
  80           CHECK_RECORD2 := CHECK_RECORD1;
  81      END IF;
  82
  83      IF CHECK_RECORD2 /= CHECK_RECORD1 THEN
  84           FAILED ("INCORRECT RESULTS FOR RELATIONAL OPERATOR");
  85      END IF;
  86
  87      RESULT;
  88 END CD2B11F;