gcc/testsuite/ada/acats/tests/c3/c37217a.ada

   1 -- C37217A.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 WHETHER THE OPTIONAL COMPATIBILITY CHECK IS
  27 --     PERFORMED WHEN A DISCRIMINANT CONSTRAINT IS GIVEN FOR AN ACCESS
  28 --     TYPE - AFTER THE TYPE'S FULL DECLARATION.
  29
  30 -- HISTORY:
  31 --     DHH 02/05/88 CREATED ORIGINAL TEST.
  32
  33 WITH REPORT; USE REPORT;
  34 PROCEDURE C37217A IS
  35
  36      SUBTYPE SM IS INTEGER RANGE 1..10;
  37
  38 BEGIN  --C37217A BODY
  39      TEST ("C37217A", "CHECK WHETHER THE OPTIONAL COMPATIBILITY " &
  40                       "CHECK IS PERFORMED WHEN A DISCRIMINANT " &
  41                       "CONSTRAINT IS GIVEN FOR AN ACCESS TYPE " &
  42                       "- AFTER THE TYPE'S FULL DECLARATION");
  43
  44                                          -- CHECK FULL DECLARATION
  45                                          -- LOWER LIMIT
  46      BEGIN
  47           DECLARE
  48
  49                TYPE SM_REC(D : SM) IS
  50                     RECORD
  51                          NULL;
  52                     END RECORD;
  53
  54                TYPE REC(D1 : INTEGER) IS
  55                     RECORD
  56                          INT : SM_REC(D1);
  57                     END RECORD;
  58
  59                TYPE PTR IS ACCESS REC;
  60
  61                Y : PTR(IDENT_INT(0));           -- OPTIONAL EXCEPTION.
  62           BEGIN
  63                COMMENT("OPTIONAL COMBATIBILITY CHECK NOT PERFORMED " &
  64                        "- LOWER");
  65                Y := NEW REC(IDENT_INT(0));      -- MANDATORY EXCEPTION.
  66                FAILED("CONSTRAINT ERROR NOT RAISED");
  67
  68                IF IDENT_INT(Y.INT.D) /= IDENT_INT(-1) THEN
  69                     COMMENT ("IRRELEVANT");
  70                END IF;
  71           EXCEPTION
  72                WHEN CONSTRAINT_ERROR =>
  73                     NULL;
  74                WHEN OTHERS =>
  75                     FAILED("UNEXPECTED EXCEPTION RAISED IN " &
  76                            "VARIABLE ALLOCATION - LOWER");
  77           END;
  78      EXCEPTION
  79           WHEN CONSTRAINT_ERROR =>
  80                COMMENT("OPTIONAL CONSTRAINT ERROR RAISED - LOWER");
  81           WHEN OTHERS =>
  82                FAILED("UNEXPECTED EXCEPTION RAISED IN " &
  83                       "VARIABLE DECLARATION - LOWER");
  84      END;
  85 ---------------------------------------------------------------------
  86                                          -- CHECK FULL DECLARATION
  87                                          -- UPPER LIMIT
  88      BEGIN
  89           DECLARE
  90                TYPE SM_ARR IS ARRAY(SM RANGE <>) OF INTEGER;
  91
  92                TYPE REC(D1 : INTEGER) IS
  93                     RECORD
  94                          INT : SM_ARR(1 .. D1);
  95                     END RECORD;
  96
  97                TYPE PTR IS ACCESS REC;
  98
  99                Y : PTR(IDENT_INT(11));           -- OPTIONAL EXCEPTION.
 100           BEGIN
 101                COMMENT("OPTIONAL COMBATIBILITY CHECK NOT PERFORMED " &
 102                        "- UPPER");
 103                Y := NEW REC'(IDENT_INT(11),     -- MANDATORY EXCEPTION.
 104                                       INT => (OTHERS => IDENT_INT(0)));
 105                FAILED("CONSTRAINT ERROR NOT RAISED");
 106
 107                IF IDENT_INT(Y.INT(IDENT_INT(1))) /= 11 THEN
 108                     COMMENT ("IRRELEVANT");
 109                END IF;
 110           EXCEPTION
 111                WHEN CONSTRAINT_ERROR =>
 112                     NULL;
 113                WHEN OTHERS =>
 114                     FAILED("UNEXPECTED EXCEPTION RAISED IN " &
 115                            "VARIABLE ALLOCATION - UPPER");
 116           END;
 117      EXCEPTION
 118           WHEN CONSTRAINT_ERROR =>
 119                COMMENT("OPTIONAL COMPATIBILITY CHECK PERFORMED " &
 120                        "- UPPER");
 121           WHEN OTHERS =>
 122                FAILED("UNEXPECTED EXCEPTION RAISED IN " &
 123                       "VARIABLE DECLARATION - UPPER");
 124      END;
 125
 126      RESULT;
 127
 128 END C37217A;  -- BODY